Excel (VBA)

Excel VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録(無料)が必要です。会員登録がまだの方はこちら
  • 掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(指定なし : 指定なし)
名前が異なる複数ファイルのデータを一つにまとめる
投稿日時: 20/08/04 15:54:13
投稿者: おひさま

初めて質問させていただきます。
同じフォルダにある名前が異なる複数ファイル(名前に規則性は全くないです)のデータを取ってきて一つのファイル(まとめファイル)にまとめたいです。
具体的にはまず、ファイル1を開き、A列とB列(結合されています)の1行目にデータが入っていれば、まとめファイルのC列のデータが入っている最終行の次の行に1と入力。またファイル1に戻りAB結合列の2行目をコピーし、まとめファイルの先程1と入力した行のD列にその値を入力、、、と何度かファイル1からデータをコピーしまとめファイルの同じ行にデータをペーストする作業をして、終わったらファイル1の右隣のCD列(こちらも結合されています)で同じ作業をする(付与する数字は2,3と増えていきます)もしデータがなければそこで終わり、もしデータがあればまたさらに右に同じ作業を繰り返し、終わった時点でまた同じフォルダの別ファイルを開き同じことをするというのをやりたいです。
ファイルの名前がそれぞれことなっているというところと、データが入っている最終行を見つけてその次の行に入れるところなどに引っかかりうまくいきません。ご回答いただけたらありがたいです。よろしくお願い致します。

回答
投稿日時: 20/08/04 17:17:16
投稿者: sk

引用:
同じフォルダにある名前が異なる複数ファイル(名前に規則性は全くないです)の
データを取ってきて一つのファイル(まとめファイル)にまとめたい

引用:
ファイルの名前がそれぞれことなっているというところと、
データが入っている最終行を見つけてその次の行に入れるところなどに
引っかかりうまくいきません。

(標準モジュール)
------------------------------------------------------------------
Sub CreateFilesList()
 
    Dim wbkSource As Excel.Workbook
    Dim wsSource As Excel.Worksheet
     
    Dim wbkDestination As Excel.Workbook
    Dim wsDestination As Excel.Worksheet
     
    Dim strFolderPath As String
    Dim strFileName As String
    Dim lngFileCount As Long
    Dim lngLastRow As Long
     
    strFolderPath = "C:\FolderName\"
    strFileName = Dir(strFolderPath & "*.xlsx")
 
    If strFileName = "" Then
        MsgBox strFolderPath & " にブックはありません。", vbExclamation, "ファイルなし"
        Exit Sub
    End If
     
    Application.ScreenUpdating = False
     
    Set wbkDestination = Workbooks.Add
    Set wsDestination = wbkDestination.Worksheets(1)
     
    lngFileCount = 0
     
    Do Until strFileName = ""
        lngFileCount = lngFileCount + 1
         
        Set wbkSource = Workbooks.Open(strFolderPath & strFileName, , True)
        '1つめのワークシートへの参照を取得
        Set wsSource = wbkSource.Worksheets(1)
        With wsSource
            'A列において値または数式が設定されている最後のセルの行番号を取得
            lngLastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
        End With
         
        With wsDestination
            .Cells(lngFileCount, 1).Value = wbkSource.FullName
            .Cells(lngFileCount, 2).Value = wsSource.Name
            .Cells(lngFileCount, 3).Value = lngLastRow
        End With
         
        Set wsSource = Nothing
        wbkSource.Close False
        Set wbkSource = Nothing
         
        strFileName = Dir()
    Loop
 
    wsDestination.UsedRange.EntireColumn.AutoFit
    wbkDestination.Activate
 
    Set wsDestination = Nothing
    Set wbkDestination = Nothing
 
    Application.ScreenUpdating = True
 
End Sub
------------------------------------------------------------------
 
こんな感じことをなさりたい、ということでしょうか。

投稿日時: 20/08/04 23:20:01
投稿者: おひさま

ありがとうございます!早速トライしてみます!

トピックに返信