【ワレコの講座】エクセルファイル①をエクセルファイル②に読み込む

ワテのブログ記事の中でも全国のエクセルファンの皆さんから絶大な人気のある記事が下記のエクセル講座シリーズだ。

【入門編】 初心者向け EXCEL VBA (7/10) – 現在のシートを加工して新シートを作成する【後半】

現在のところ、以下の７つのEXCEL VBA講座がある。 第一回目 【入門編】 初心者向け EXCEL VBA (1/10) – 今年こそ使えるようになりたい人 第二回目 【入門編】 初心者向け EXCEL VBA (2/10) –実際にV

www.wareko.jp

さて、そんなワテの記事に、先日、しがない事務員さんより以下のコメントを頂いた。

しがない事務員 より:
2017年11月8日 1:07 PM

VBA初心者です。といってもほとんどマクロの記録ばかり利用しています。
第1回～7回まで拝見いたしました！!今まで見た本やサイトよりも分かりやすいです。

アドバイスをいただきたく、コメントしました。
毎日名前が変わるファイルからデータを貼り付けしたいのですが、その場合はどうすれば良いのでしょうか。色々ネット検索してみましたが解決できずに困っています。

①売上（20171101）.xlsm　※次の日にはカッコ内の日付が変わる
②売上進捗報告.xlsm

①のデータを②のシートに貼り付けて加工していますが、
毎日日付が変わるため、その都度モジュールの日付部分のみを手作業で更新しています^^;

小生のEXCEL VBA記事が分かり易かったとのお褒めの言葉を頂いて嬉しい。

さて、しがない事務員さんのやりたい内容は大体は分ったが、①のデータを②のシートに貼り付ける処理は手作業なのかプログラムなのか分からない。

その点に関して、追加コメントで詳しい説明を頂いた。

しがない事務員 より:
2017年11月9日 11:22 AM

・①のデータを②に貼り付ける作業は、マクロ記録したものを実行しております。
　内容としては、フィルタをかけて、不要な項目を削除してから貼り付けるよう記録しています。

・②のマクロを実行する前に以下の作業を行っております。
　「マクロ編集　⇒　Windows(“売上（20171102）.xlsm”).Activate　⇒日付のみ更新して閉じる⇒マクロ実行」

この日付を手動で更新する作業を自動化したいです。。。
お手すきの際に構いませんので、ご教示いただけますと大変嬉しいです。
何卒よろしくお願いいたします。

う～ん、なるほど。

要するに、②のマクロを実行して①のファイルを読み込む時に、複数ある①のファイルのどの日付のやつを選ぶかと言う点を改良したい訳だ。

現状では、毎回読み込むファイルの名前を手作業で書き換えて指定している。

それを自動化したい。そう言う事か！

自称EXCEL VBAの達人（いや変人）のワテとしては、このようなお問い合わせが有った以上は、何かお役に立てるようにお答えしなくてはならないだろう。

この記事では、しがない事務員さんのやりたい内容をVBAで実現すべく、ワテのプログラミング能力を最大限に発揮してサンプルプログラムを作ってみたので、その製作過程の紹介したい。

本ページで使用したEXCELファイルをダウンロードしたい人はここからどうぞ。

『【ワレコEXCEL講座】エクセルファイル①をエクセルファイル②に読み込む』の全VBAコードのzipファイル

 

 

では、本題に入ろう。

『①売上（20171101）.xlsm』はこんな感じか

例えば①売り上げファイルのサンプルを作ってみた。

こんな感じで複数の売り上げファイルが日々溜まって行く感じか。

以下では、これらの売り上げファイルは特定の名前のフォルダ [売上ﾌｧｲﾙ保存場所] に保管されているとする。

その売り上げファイルの中身は、例えばこんな感じかな。

まあ、ちょっと簡素過ぎるが、あくまでサンプルなので。

こんな感じの売り上げファイルが、毎日生成されるとの事だ。

• 売上（20171101）.xlsm
• 売上（20171102）.xlsm
• 売上（20171103）.xlsm

その中で、今日の日付の売り上げファイルを、②売上進捗報告.xlsmに読み込んで貼り付ける。

その部分を自動化するのが今回のプログラミングの目的だ。

『②売上進捗報告.xlsm』から複数ある①のファイルを指定して読み込む

②売上進捗報告.xlsmが、①売上（20171101）.xlsmファイルを読み込み処理はマクロを実行しているとの事だ。

ただし、読み込む前に、どの日付の売り上げファイルを読み込むのかを手で修正している。

その部分を自動化したいとの事だ。

なるほど。

 

即席で、VBAプログラムを作ってみた。

売上進捗報告.xlsmを実行する

プログラムの名前は、『売上進捗報告.xlsm』だ。

ワテのEXCEL2013の環境でファイルを開くと下図の画面が出る。

シートの上に二つのボタンがある。

[売上（YYYYMMDD）.xlsmファイルを読み込む]

[クリア]

の二個のボタンだ。

 

一つ目の[売上（YYYYMMDD）.xlsmファイルを読み込む]ボタンをクリックすると以下のウインドウが開く。

これは、プログラム中で指定している[売上ﾌｧｲﾙ保存場所] フォルダの中にある、

売上（YYYYMMDD）.xlsm

と言うパターンにマッチする全ファイルを取得して、リストボックスの要素に追加して表示している。

 

ここで、希望する売上ファイルを選択して（下図）、

[決定]ボタンをクリックする。

そうすると、下図の確認画面が表示される。

ここで[はい]をクリックすると先ほど選択した日付の売り上げファイルが読み込まれて下図のように貼り付けられる。

なお、今の場合には売上ファイルが三つある例を示した。

もし、[売上ﾌｧｲﾙ保存場所] フォルダの中に売上ファイルが一個しか無い場合には、リストボックスでの選択画面は表示せずに、見付けたその一つの売り上げファイルを読み込む処理を行う。

もし、[売上ﾌｧｲﾙ保存場所] フォルダの中に売上ファイルが無い場合には、何もせずに終了する。

上図のように売上ファイルを読み込む事が出来た。

なお、売上ファイルのどの範囲を読み取って、それを報告ファイルのどこに貼り付けるのかは、プログラム中で固定の文字列で指定しているので、必要なら編集すると良いだろう。

 Dim rngFr As String 'Range From
 Dim rngTo As String 'Range To
 rngFr = "B2:E8" '
 rngTo = "A1:D7" '

こんな感じ。

 

最後に、[クリア]ボタンをクリックすると、今読み込んだデータを削除する（下図）。

まあこれは、プログラム作成時に何度もテストするので、付けた機能であるが、不要なら削除して頂いても構わない。

その全VBAコードを紹介しよう。

Module1とUserForm1の二つのソースコードに分かれている。

まずは、Module1から。

Module1の中身

'==================================================================================================================
'【ワレコのVBAサンプルプログラム】
'
'【著作権】フリー
'
'【製作日】2017-11-09(木) by Wareko
'
'【解決する課題】
'
'しがない事務員 さんより問い合わせが有った下記の処理を行うサンプルプログラムの作成
'
'2017年11月8日 1:07 PM
'アドバイスをいただきたく､コメントしました｡
'毎日名前が変わるファイルからデータを貼り付けしたいのですが､その場合はどうすれば良いのでしょうか｡色々ネット検索してみましたが解決できずに困っています｡
'
'①売上(20171101).xlsm ※次の日にはカッコ内の日付が変わる
'②売上進捗報告.xlsm
'
'①のデータを②のシートに貼り付けて加工していますが､
'毎日日付が変わるため、その都度モジュールの日付部分のみを手作業で更新しています^^;
'
'・①のデータを②に貼り付ける作業は、マクロ記録したものを実行しております。
'  内容としては､フィルタをかけて､不要な項目を削除してから貼り付けるよう記録しています｡
'
'・②のマクロを実行する前に以下の作業を行っております。
'　「マクロ編集　⇒　Windows(“売上（20171102）.xlsm”).Activate　⇒日付のみ更新して閉じる⇒マクロ実行」
'
'この日付を手動で更新する作業を自動化したいです｡｡｡
'
'【ﾌﾟﾛｸﾞﾗﾑの説明】
'
'②売上進捗報告.xlsm　　　は、今見ているこのﾌｧｲﾙ自身とする
'①売上(20171101).xlsm　　は、②のﾌｧｲﾙがあるﾌｫﾙﾀﾞにｻﾌﾞﾌｫﾙﾀﾞ[売上ﾌｧｲﾙ保存場所]を作り、その中に何日分もの売上ﾌｧｲﾙが入っているとする。
'　　　　　　　　　　　　 もし売上ﾌｧｲﾙの場所を絶対ﾊﾟｽで指定するなら↓のｸﾞﾛｰﾊﾞﾙ変数[g_売上Path]の部分を少し修正すれば可能。
'
'
'【動作保証】
'多分、期待通りに動くと思うが、バグなどがある可能性もあります。
'
'==================================================================================================================

'使う変数は必ず宣言して使う
Option Explicit

'【ｸﾞﾛｰﾊﾞﾙ変数など】
Public G_Selected売上File As String  'UserForm1のSub CommandButton1_決定_Click()関数内で選択した売上ﾌｧｲﾙ名を入れる

'売上ファイル保存場所のパス名を保持する変数。このModule内の幾つかの関数内で使う。
Private g_売上Path As String
'もし↑のﾊﾟｽ名を絶対ﾊﾟｽで指定したい場合には↑をｺﾒﾝﾄ化して下の行↓を有効化すると同時に①↓の部分をｽｷｯﾌﾟ。
'Const  g_売上Path As String = "E:\(パス名を指定する)\2017-11-08-ﾌｧｲﾙ名のYYYYMMDDを読み取ってxlsm内で利用する\売上ﾌｧｲﾙ保存場所\"    '末尾\記号忘れない


Public Sub 売上進捗報告処理の作成()

'x  g_売上Path = CurDir()  ' MyDocumentsになるようだ。
    g_売上Path = ActiveWorkbook.Path + "\売上ﾌｧｲﾙ保存場所\" '①

    Dim 売上ファイル名 As String
    売上ファイル名 = 最新の売上YYYYMMDDファイル名の取得

    Dim msg As String
    msg = "選択した売上ファイル   [" & 売上ファイル名 & "]" + vbCrLf _
        + "で売上進捗報告作成処理を行いますか？"
    
    If 売上ファイル名 = "" Then
        MsgBox "売上ファイル名が取得出来なかった。"
    Else
        Dim rc As Integer
        rc = MsgBox(msg, vbYesNo + vbQuestion, "確認")
        If rc = vbYes Then
            'MsgBox ("処理を行います")
            Dim rngFr As String 'Range From
            Dim rngTo As String 'Range To
            rngFr = "B2:E8"   '
            rngTo = "A1:D7"   '
            
            Call 他のエクセルファイルのデータを読み込む(g_売上Path & 売上ファイル名, rngFr, rngTo)
        Else
            'MsgBox "処理を中断します"
        End If
    End If

End Sub

Private Function 最新の売上YYYYMMDDファイル名の取得() As String

    Dim fileName As String
    Dim cnt As Long
    
    '売上ﾌｧｲﾙ名のﾊﾟﾀｰﾝを指定する（必要なら修正する）
    'Const 売上FilePattern As String = "*.*"                    ’全取得
    'Const 売上FilePattern As String = "売上（2017*）.xlsm"     ' ok
    'Const 売上FilePattern As String = "売上（2017?1??）.xlsm"  ' 1月と11月のみ
    'Const 売上FilePattern As String = "売上（2017????）.xlsm" ' 2017年のみ
    Const 売上FilePattern As String = "売上（20??????）.xlsm" ' 20XX年のみ 
   
    Dim 売上PathFilePattern As String
    売上PathFilePattern = g_売上Path & 売上FilePattern
    
    'Dir関数を使って指定したﾌｫﾙﾀﾞ内のﾌｧｲﾙ名を全取得する
    '参考ｻｲﾄ
    'https://msdn.microsoft.com/ja-jp/library/dk008ty4(v=vs.90).aspx
    'Dir 関数は、複数文字 (*) および単一文字 (?) のワイルドカードに対応しており、複数のファイルを一度に指定できます。
    
    fileName = Dir(売上PathFilePattern)
    
    Dim 売上FileCollection As New Collection
    
    Do While fileName <> ""
        cnt = cnt + 1
       'Cells(cnt, 1) = fileName
        売上FileCollection.Add fileName
        fileName = Dir()
    Loop
   
    'Dir関数で読み取り順を操作できる？
    'https://oshiete.goo.ne.jp/qa/239439.html
    'を見ると、出来ないようなので自分でソートしてみた。
    'でもｿｰﾄしなくても日付順に並んでいるようだが。
   
    Set 売上FileCollection = bubble_sort(売上FileCollection) 'ﾊﾞﾌﾞﾙｿｰﾄする
    
    '上で得られた売上ﾌｧｲﾙをﾘｽﾄﾎﾞｯｸｽに表示して、処理対象にする売上ﾌｧｲﾙを決定する。
    G_Selected売上File = ""
    
    If 売上FileCollection.Count >= 2 Then
        'もし複数の売り上げファイルが見つかった場合には、ﾘｽﾄﾎﾞｯｸｽで選択する。
        Call ListBox1_AddItems(売上FileCollection)
        UserForm1.Show
        最新の売上YYYYMMDDファイル名の取得 = G_Selected売上File
        
        'でもﾘｽﾄﾎﾞｯｸｽの選択をせずに、最新の日付ﾌｧｲﾙを処理対象とするなら、上のListBox1の部分は削除して
        '最新の売上YYYYMMDDファイル名の取得 = 売上FileCollection.item(売上FileCollection.Count)　' この一行を実行するだけで良いと思うが、未ﾃｽﾄ
    ElseIf 売上FileCollection.Count = 1 Then
        '売上ﾌｧｲﾙが一個だけなら、それを使う事にした。もし事前確認するなら上のﾘｽﾄﾎﾞｯｸｽを使っても良いだろう。
        最新の売上YYYYMMDDファイル名の取得 = 売上FileCollection.item(1)
    Else 'まあこの場合は起こり得ないと思うが念のため空文字列を返し、何も処理をせずに終了する。
        最新の売上YYYYMMDDファイル名の取得 = ""
    End If
    
End Function

Private Sub ListBox1_AddItems(file As Collection)
    '見付かった売上ﾌｧｲﾙをﾘｽﾄﾎﾞｯｸｽに追加する関数

   'UserForm1.ListBox1.Clear    'UserForm1を[キャンセル]ﾎﾞﾀﾝで閉じる時にUnloadする事にしたのでClearは無くても良い。

    Dim i As Long
    For i = 1 To file.Count
       'UserForm1.ListBox1.AddItem i & ":" & file.item(i)
       UserForm1.ListBox1.AddItem file.item(i)
    Next i
    'UserForm1.ListBox1.AddItem "先頭データ", 0  'こうするとﾘｽﾄﾎﾞｯｸｽの先頭に要素を追加出来るようだ。
End Sub

Private Function bubble_sort(cFruit As Collection) As Collection
    '【機能】コレクションを昇順にソートする
    ' ↓のｻｲﾄで見付けた。詳しく見ていないが英数字の昇順にソートされるので、日付の最も新しいﾌｨｱﾙ名は、コレクションの末尾要素になる。
    '【引用元】
    'How do I sort a collection?
    'https://stackoverflow.com/questions/3587662/how-do-i-sort-a-collection

    Dim i As Long
    Dim j As Long
    Dim vItm As Variant
    Dim vTemp As Variant 'x Object
    'Two loops to bubble sort
    For i = 1 To cFruit.Count - 1
        For j = i + 1 To cFruit.Count
            If cFruit(i) > cFruit(j) Then
                'store the lesser item
               vTemp = cFruit(j)
                'remove the lesser item
                cFruit.Remove j
                're-add the lesser item before the
                'greater Item
                cFruit.Add vTemp, vTemp, i
            End If
        Next j
    Next i

    'Test it
    For Each vItm In cFruit
        Debug.Print vItm
    Next vItm
    
    Set bubble_sort = cFruit
End Function

Private Sub 他のエクセルファイルのデータを読み込む(売上Filename As String, rngFr As String, rngTo As String)

    Dim 売上WorkbookFr As Workbook
    Dim 報告workbookTo As Workbook

    Set 報告workbookTo = Application.ActiveWorkbook

    Set 売上WorkbookFr = Application.Workbooks.Open(fileName:=売上Filename, ReadOnly:=True)

    Dim 報告sheetTo As Worksheet
    Set 報告sheetTo = 報告workbookTo.Worksheets(1)
    Dim 売上sheetFr As Worksheet
    Set 売上sheetFr = 売上WorkbookFr.Worksheets(1)

    '値、書式、罫線などをｺﾋﾟｰする
    売上sheetFr.Range(rngFr).Copy
    With 報告sheetTo.Range(rngTo)
        .PasteSpecial xlPasteColumnWidths
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
        'Rows("10:10").RowHeight = 20 '行の高さを変える
    End With

    売上WorkbookFr.Close

End Sub

Public Sub Clear()
    ActiveSheet.Cells.Clear
    ActiveSheet.Select
    Selection.Borders.LineStyle = xlNone  '罫線を消す
    Cells(1, 1).Select
End Sub

Public Sub Test1_BubbleSort()

    'ﾊﾞﾌﾞﾙｿｰﾄ関数の単体ﾃｽﾄ
    Dim vItm As Variant

    Dim 売上FileCollection As New Collection
    売上FileCollection.Add ("売上（20141002）.xlsm")
    売上FileCollection.Add ("売上（20171102）.xlsm")
    売上FileCollection.Add ("売上（20131002）.xlsm")
    売上FileCollection.Add ("売上（20171021）.xlsm")
    売上FileCollection.Add ("売上（20171103）.xlsm")
    
    Debug.Print "---　ﾊﾞﾌﾞﾙｿｰﾄ前　---"
    For Each vItm In 売上FileCollection
        Debug.Print vItm
    Next vItm
    Debug.Print "--------------------"
    
    Set 売上FileCollection = bubble_sort(売上FileCollection) 'ﾊﾞﾌﾞﾙｿｰﾄする
    
    Debug.Print "---　ﾊﾞﾌﾞﾙｿｰﾄ結果　---"
    For Each vItm In 売上FileCollection
        Debug.Print vItm
    Next vItm
    Debug.Print "--------------------"

End Sub

まあ、ある程度は整理したつもりなのだが、コメントの中には自分用のメモみたいなのも多いので必要に応じて皆さん自身で整理して頂きたい。

グローバル変数をもっと減らしてスッキリ書き直しても良いだろう。

その後、幾つか気になった部分があるのでメモしておく

読み込んだエクセルシートのデータを貼り付ける時のオプション

上のコードでは、xlPasteValues を指定しているので数式が渡らない。

なので、数式も渡したい場合には、

 '.PasteSpecial xlPasteValues                   'これはやめて
 .PasteSpecial xlPasteFormulasAndNumberFormats　'あるいは xlPasteAll など

のように、xlPasteFormulasAndNumberFormats あるいは  xlPasteAll などに変更すると良いだろう。

他のエクセルファイルを読み込む時に画面がチカチカする

他のエクセルファイル（この例では①売上（20171101）.xlsm）を読み込んで、貼り付ける場面では画面がチカチカする。

その理由は、読み込むエクセルファイルを Application.Workbooks.Open() 関数を使って開くからだ。

まあ、画面がチカチカするするほうがダイナミックで迫力があり、エクセルVBAが動いているぞと他人にアピール出来るのでそのままでも良いかも知れないが、気になる人もいる。

 Application.ScreenUpdating = False
 Call 他のエクセルファイルのデータを読み込む(g_売上Path & 売上ファイル名, rngFr, rngTo)
 Application.ScreenUpdating = True 

そう言う場合には、上に示すように読み込み処理中には画面の更新を停止しておけば、多少はチカチカ感を抑制出来る。

ただし、ワテが試した限りでは、完全にはチカチカを止める事は出来なかった。

EXCELのウインドウの周囲がチラチラする。

その挙動を完全に抑制する方法があるのかどうかは未確認だ。

バブルソートで逆順（降順）に並べる

StackOverflowで見付けたバブルソートのコードを引用して利用している。

現状では、ファイル名で昇順にソートされる（下図）。

売上（20171101）.xlsm
売上（20171102）.xlsm
売上（20171103）.xlsm

もし降順に並べ替えて、最新日付ファイルを先頭に持ってきたい場合には（下図）

売上（20171103）.xlsm
売上（20171102）.xlsm
売上（20171101）.xlsm

バブルソートのコードの以下の部分で不等号を逆にすれば良いだろう。

 For i = 1 To cFruit.Count - 1
    For j = i + 1 To cFruit.Count
       If cFruit(i) > cFruit(j) Then　'オリジナルの昇順ソート 1, 2, 3, 4, 5
          ・・・

つまり、

If cFruit(i) < cFruit(j) Then ' 降順　5, 4, 3, 2, 1

とすれば降順になる。

UserForm1の中身

今回用いたユーザーフォームは以下のようにFormの上にListBoxとボタンが二個だけの簡単な画面レイアウトだ。

UserForm1のレイアウト

そのコードは以下の通り。

UserForm1のVBAコード

'使う変数は必ず宣言して使う
Option Explicit

Private Sub CommandButton1_決定_Click()
    Dim selectedItem As String
    Dim selectedIndex As Long ' indexは1,2,3,... のように1から始まる。0は無い
    
    selectedIndex = UserForm1.ListBox1.ListIndex
    If selectedIndex <= -1 Then
        G_Selected売上File = ""
    Else
        selectedItem = UserForm1.ListBox1.List(selectedIndex)
        G_Selected売上File = selectedItem 'ここで代入して、この後Moduleで利用する
        'MsgBox "選択した売上ファイル   [" & UserForm1.ListBox1.List(selectedIndex) & "]"
    End If
    Unload UserForm1
End Sub

Private Sub CommandButton2_キャンセル_Click()
    Unload UserForm1 'UnloadするとListBox1に読み込んでいるitemは全部無くなるので、item追加する前に事前に'UserForm1.ListBox1.Clearしなくても良い
    'UserForm1.Hide  'Hideだとitemを追加する前に毎回　UserForm1.ListBox1.Clear　で削除しておく必要あり。
End Sub

 

まとめ

さて、このプログラムが「しがない事務員さん」がやりたい内容に合致しているのかどうか、それが一番気になるところだ。

もし、見当違いなプログラムでしたら、ご遠慮なく指摘下さい。

すぐに修正版を作成します。無料ですｗ

著作権はフリーです。

自由に使って下さい。

EXCEL VBA関連のお問い合わせ募集中

この記事で紹介しました「しがない事務員さん」からのお問い合わせのように、何かEXCELやEXCEL VBA関連で「こんな事がやりたいのだがやり方が分からない」と言う疑問、質問がありましたら、下のほうにあるコメント欄からお気軽にお問い合わせください。

相談無料です。有料でもいいからこんなの作って欲しい！と言うのも歓迎ですが！！

ワテの時間がある限り、お答えいたします。

感想など

久しぶりに即席でVBAのコードを書いたので、文法を思い出すのに苦労した。

Object変数よりもVariantを使うほうが手っ取り早いなあ。取り敢えずVariantにしておけば何でも入るし。

変数名、関数名がヘンテコだと言うご指摘があるかも知れないがその通りです。

気になる人は、適当に修正して下さい。

もっとスマートに記述出来るかもしれないが、まあ、ワテのモットーとしては、取り敢えず動くプログラムを素早く完成させる事が最も重要だ。

改良はその後でやっても良いし。

 

コメントに半角ｶﾀｶﾅが使われているのが気になる人も居るかもしれない。

まあ、ワテの場合、半角ｶﾀｶﾅは良く使う。

文章にもファイル名、フォルダ名にも。理由は、字が詰まって密度の高い文章を書けるので。

なんのこっちゃ良く分からん理由だ！

あるいは、昔はプログラミングの変数名にも半角ｶﾀｶﾅを使っていた事もあるが、最近はそれはやめている。さすがにそれはヘンテコ過ぎるかなあと思ったので。

EXCEL VBAの本を読む

物凄いタイトルだな。

こんなに強気のタイトル、小心者のワテには付けられない。

 

有名なブルーバックスシリーズだ。コンパクトなので通勤電車の中でも読み易い。

 

本格的にEXCEL VBAを勉強するなら、この本がお勧めだ。

何と言っても内容が豊富でVBAの具体的な使用例を300個以上掲載との事だ。

960ページもある！

EXCEL 2003の頃からあるらしいから、改定を重ねて発行され続けている歴史ある本のようだ。

アマゾンのレビューも高評価が多い。

もしワテが買うなら、この最後の本かな。