폴더의 CSV 파일을 통합하는 매크로 2

이번에는 그 1에서 만든
『같은 폴더 안에 있는 CSV 파일을 사용 범위를 그대로 복사하여 통합하는 매크로』
붙여넣기 위한 "청구 통합.xlsx"를 미리 준비하고 복사 범위의 시작행을 inputbox로 지정할 수 있도록 개선했습니다.

Sub tougou02()

'フォルダを選択
    Dim folderPath As Variant
    With Application.FileDialog(msoFileDialogFolderPicker)
        .Show
        folderPath = .SelectedItems(1)
    End With

'Dir関数でCSVファイル名を取得
    Dim buf As String
    buf = Dir(folderPath & "\" & "*.csv")
    Debug.Print buf        'ファイル名を確認

'貼り付け元の「請求統合.xlsx」ファイルを開いて最初のシートを指定
    Dim bath As Workbook
    Set bath = Workbooks.Open(folderPath & "\" & "請求統合.xlsx")
    Dim tougouWs As Worksheet
    Set tougouWs = bath.Worksheets(1)

'CSVファイルの転記位置が上から何行目かをインプットボックスで指定
'(「j」が空白を入力されたときにメッセージを出したいので、Long型ではなくString型を指定)
    Dim j As String
    j = InputBox("CSVファイルの転記の開始は何行目ですか?(半角英数で入力してください)")

    If j = "" Then
        MsgBox "空白が入力されました。最初からやり直してください"
        Exit Sub
    End If

'CSVファイルの一番右下のセルの位置
    Dim maxRows As Long
    maxRows = Cells(1, Columns.Count).End(xlToLeft).Column

'ループ開始・CSVファイルの名前が空白になったら(取得できなかったら)ループから外れる
    Do While buf <> ""

'「請求統合.xlsx」の最終行を取得
        With tougouWs
            Dim bathLastLine As Long
            bathLastLine = .Cells(Rows.Count, 1).End(xlUp).Row
        End With

'CSVファイルの最初のシートを取得
            Dim wb As Workbook
            Set wb = Workbooks.Open(folderPath & "\" & buf)
            Dim ws As Worksheet
            Set ws = wb.Worksheets(1)

'CSVファイルの最下行を取得し範囲指定してコピー(クリップボード)
'最終行:lastLine
            Dim csvLastLine As Long
            csvLastLine = ws.Cells(Rows.Count, 1).End(xlUp).Row
            ws.Range(Cells(j, 1), Cells(csvLastLine, maxRows)).Copy

'「請求統合.xlsx」のA列の最終行の次のセルを指定し貼り付け
            With tougouWs
                .Activate
                .Cells(bathLastLine + 1, 1).Activate
            End With
            ActiveSheet.Paste

'CSVファイルを保存せずに閉じる
            wb.Application.CutCopyMode = False
            wb.Saved = True
            wb.Close

'次のCSVファイルを指定する
            buf = Dir()
    Loop

'「請求統合.xlsx」を保存して閉じる
    bath.Save
    bath.Close

End Sub

그건 그렇고, 다음 부분이지만
'CSVファイルの転記位置が上から何行目かをインプットボックスで指定
'(「j」が空白を入力されたときにメッセージを出したいので、Long型ではなくString型を指定)
    Dim j As String
    j = InputBox("CSVファイルの転記の開始は何行目ですか?(半角英数で入力してください)")

    If j = "" Then
        MsgBox "空白が入力されました。最初からやり直してください"
        Exit Sub
    End If

inputbox를 Long으로 선언하면 아무것도 입력하지 않고 "OK"를 클릭하면 오류가되어 버리기 때문에 문자열 인 String로 선언했는데 ... 괜찮습니까? 일단 검증한 결과는 String에서도 copipe는 가능했습니다.

다음번에는 개인적으로 추가하고 싶은 기능 「통합시에 가장 오른쪽의 셀에 각 CSV 파일명의 일부를 입력한다」의 대응을 하고 싶습니다.

좋은 웹페이지 즐겨찾기