소개

안녕하세요. VBA 초보자입니다.
이 절에서는 VBA에서 폴더의 여러 파일을 하나의 파일로 집계하는 방법을 기록합니다.

실은 이것에 가까운 코드라고 하는 것은 벌써 넷에 뻔뻔하고 굴러가고 있습니다만,
아무래도 내가 원하는 사양과는 다르다…

그래서 저와 같은 처지를 향한 정보 공유와 자신의 배우기 정리를 위해 정리해 갑니다.

목적

· 대량의 데이터를 VBA를 사용하여 하나의 엑셀 시트에 초효율적으로 정리한다.

전제

・VBA 초보자용 내용
· 정리하고 싶은 파일의 내용은 모두 동일한 형식으로 한다.

활용 장면

・각월에 나누고 있던 매출 정보를 정리하고 싶다
・지점별로 나누고 있는 데이터를 정리하고 싶다
· Excel에서 답변을 받은 설문 결과를 요약하고 싶습니다.
… 등등



※이미지도. 값은 적당하지만 용서해주세요! 뉘앙스가 전해지면 좋다!

실제로 써보자

정책

① 복사하려는 폴더에서 엑셀북의 파일명을 취득하고 열
② 최종행(빈 셀에 도달할 때까지)을 취득해, 거기까지를 카피
③집계처 파일에서도 최종행을 취득해, 그 이후에 붙여 넣는다
④ 복사 원본 파일 닫기
⑤,①～④를 반복한다
⑥ 폴더 내의 모든 파일의 복사본이 종료
⑦ 빈 행을 삭제하기 위해, 여기에서는 B열의 값을 취득. 빈 줄 식별.
⑧ 공백행을 점점 변수에 대입해 간다
⑨ 공백행이 들어간 변수를 통째로 소거
⑩집계처 파일을 저장하고 종료

꽤 씹어서 쓰면 이런 느낌입니다.
이것을 코드에 떨어 뜨리자.

집계 매크로.xlsm

Option Explicit
 Sub 集約マクロ()

'初期設定

 '変数の設定

  'コピー元ファイル
    Dim sFile As String

  'コピー元と集約用のエクセルブック
    Dim sWB As Workbook, dWB As Workbook

  '集約先、コピー元の最終行取得用
    Dim lR As Variant
    Dim lastRow As Variant
    Dim lastRowP As Variant
    Dim Row As Variant
    Dim Col As Variant

  'コピー元の空白行を削除する用
    Dim GYO As Long
    Dim KuhakuGyo As Range
    Dim r As Long

 'フォルダとファイルのパス設定   
  '集約したい対象のファイルが入っているフォルダのフルパスを設定
    Const SOURCE_DIR As String = "フォルダのフルパス"
  '集約先にしたいファイルのフルパス設定
    Const DEST_FILE As String = "集約マクロ.xlsm"

  '不要な画面描画の抑制とアラートの非表示
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

'処理開始
 'コピペ処理
  'パスで指定したフォルダ内にあるエクセルブックのファイル名を取得
    sFile = Dir(SOURCE_DIR & "*.xls")

  'フォルダ内にブックがなければ終了
    If sFile = "" Then Exit Sub

  '集約用ブックを作成
    Set dWB = ActiveWorkbook

    Do

  '集約先シート最終行取得
    dWB.Worksheets("集約先のタブの名前").Activate
    lastRow = ActiveSheet.Cells(1, "A").SpecialCells(xlLastCell).Row

  '集約先出力行セット
    lR = lastRow + 1

  'コピー元のブックを開く
    Set sWB = Workbooks.Open(Filename:=SOURCE_DIR & sFile)

  'コピー元シートの最終行、最終列取得
    sWB.Worksheets("データのあるタブの名前").Activate
    Row = sWB.Worksheets("データのあるタブの名前").Range("A5").SpecialCells(xlLastCell).Row
    Col = sWB.Worksheets("データのあるタブの名前").Range("A1").SpecialCells(xlLastCell).Column

  'コピー
   sWB.Worksheets("データのあるタブの名前").Activate
   sWB.Worksheets("データのあるタブの名前").Range(Cells(5, 1), Cells(Row, "T")).Copy

  '張り付ける
   dWB.Worksheets("集約先のタブの名前").Activate
   dWB.Worksheets("集約先のタブの名前").Range("A" & a).PasteSpecial Paste:=xlPasteAll

  'コピー元ファイルを閉じる
   sWB.Close

  '次のブックのファイル名を取得
   sFile = Dir()
   Loop While sFile <> ""

  '空白行の削除
   'A列を参照し、シートの最終行を取得する
    GYO = Cells(Rows.Count, 1).End(xlUp).Row

   '2行目から最終行まで、B列のセルをチェック
    With ActiveSheet
    For r = 2 To GYO

    'B列のセルが空白なら変数KuhakuGyoに追加
    If IsEmpty(Cells(r, 2).Value) Then

    '最初の空白行に出会ったら行全体を KuhakuGyo にセット
    If KuhakuGyo Is Nothing Then
    Set KuhakuGyo = .Rows(r).EntireRow

    '2件目からは順次 KuhakuGyo に追加していく
    Else
    Set KuhakuGyo = Union(KuhakuGyo, .Rows(r).EntireRow)
    End If

    End If

    Next r

    End With

    '空白行があれば一括で削除する
    If Not KuhakuGyo Is Nothing Then
    KuhakuGyo.Delete
    End If

    '集約用ブックを保存
    dWB.SaveAs Filename:=DEST_FILE

    '集約完了メッセージの表示
    MsgBox "集約が完了しました"

End Sub

끝에

보충

・카피원의 Range(범위)를 지정할 때에 타이틀행이나 특정 열만을 복사하고 싶은 경우는, 그때마다 Range의 값을 바꾸면 됩니다.

・집계처의 파일에 값이 아무것도 없는, 새하얀 시트의 경우, 에러가 일어납니다. 집약처에는, 사전에 타이틀행등을 설정해 두어, 테이블을 작성. 그 표에 잘 맞도록 Range를 지정하면 좋다고 생각합니다.

이상입니다!