VBA의 기본 조작(응용 1)

이번은 지금까지의 기사의 내용을 근거로 조금 본격적인 코드를 소개하고 싶습니다.

<폴더의 내용>


<파일의 내용>


이런 느낌으로 폴더안에 주문서의 일람이 있었을 경우에 각각 필요한 데이터를 추출해, 정리한다고 하는 것을 해 가고 싶습니다.

Sub test()
    Dim folderPath As String
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ""
        If .Show = True Then
            folderPath = .SelectedItems(1)
        Else
            Exit Sub
        End If
    End With

    Dim fso As Object
    Dim file As Object
    Dim str1 As Variant
    Dim str2 As Variant
    Dim str3 As Variant
    Dim str4 As Variant
    Dim SetFile As String
    Dim wbMoto, wbSaki As Workbook
    Dim j As Long
    Dim W As Long
    Dim Buf As Long
    Dim ex  As New Excel.Application
    Dim wb As Workbook

    Buf = 0  '最大小計
    SunX = 0 'ブックごとの合計数量
    SunY = 0 'ブックごとの合計金額

    Set wbMoto = ActiveWorkbook
    Application.DisplayAlerts = False
    Set fso = CreateObject("Scripting.FileSystemObject")
    ReDim BaseNames(fso.getFolder(folderPath).Files.Count)


    For Each file In fso.getFolder(folderPath).Files
        cnt = cnt + 1
        BaseNames(cnt) = fso.GetBaseName(file.Name)

        '項目の表示
        Range("A1") = "発注番号"
        Range("B1") = "発注者"
        Range("C1") = "発注先"
        Range("D1") = "小計最大品名"
        Range("E1") = "小計最大価格"
        Range("F1") = "数量合計"
        Range("G1") = "金額合計"

            '発注ナンバーと発注者の抽出
            str1 = Split(BaseNames(cnt), "注文書")
            Cells(cnt + 1, 1) = Mid(str1(1), 1, 6)
            str2 = Split(str1(1), "(")
            str3 = Split(str2(1), ")")
            str4 = Split(str3(0), "2")
            Cells(cnt + 1, 2) = Split(str4(0), "2")       

            '発注先の抽出
            SetFile = folderPath & "\" & BaseNames(cnt)
            Set wb = ex.Workbooks.Open(Filename:=SetFile, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)
                wb.Worksheets(1).Range("A6").Copy
                wbMoto.Worksheets(1).Cells(cnt + 1, 3).PasteSpecial xlPasteFormulasAndNumberFormats
                Application.CutCopyMode = False

             '最大小計の品目抽出
            For j = 12 To 26
                If Buf < wb.Worksheets(1).Cells(j, 5) Then
                    Buf = wb.Worksheets(1).Cells(j, 5)
                End If
            Next j

            '最大小計（金額）のコピー
            wbMoto.Worksheets(1).Cells(cnt + 1, 5) = Buf

            '最大小計（品目）のコピー
            For j = 12 To 26
                If wb.Worksheets(1).Cells(j, 5) = Buf Then
                    wbMoto.Worksheets(1).Cells(cnt + 1, 4) = wb.Worksheets(1).Cells(j, 1)
                End If
            Next j

            Buf = 0

            '数量の合計
            For K = 12 To 26
                SunX = SunX + wb.Worksheets(1).Cells(K, 2)
            Next K
            wbMoto.Worksheets(1).Cells(cnt + 1, 6) = SunX
            SunX = 0


            '金額の合計
            For W = 12 To 26
                SunY = SunY + wb.Worksheets(1).Cells(W, 5)
            Next W
            wbMoto.Worksheets(1).Cells(cnt + 1, 7) = SunY
            SunY = 0

            'ブックを閉じる
            'wbSaki.Close False

            'ブックを閉じる
            Call wb.Close

            'Excelアプリケーションを閉じる
            Call ex.Application.Quit
    Next

    Range("E2 : E51").NumberFormatLocal = "#,###"
    Range("G2 : G61").NumberFormatLocal = "#,###"
End Sub

<동작 결과>

이런 느낌이 듭니다. 그러면 어려운 부분을 나누어 설명합니다.

폴더 지정 및 파일 결정

    'フォルダパスの変数設定
    Dim folderPath As String

    'FileDaialogによるフォルダの指定
    With Application.FileDialog(msoFileDialogFolderPicker)
        .InitialFileName = ""

        If .Show = True Then   'ファイルがあった場合
            folderPath = .SelectedItems(1)
        Else   'ファイルがなかった場合
            Exit Sub
        End If
    End With

선택한 파일에 설정

    '選択中のファイルを「wbMotp」とする
    Set wbMoto = ActiveWorkbook

    '確認メッセージを開かなくする
    Application.DisplayAlerts = False

    'fsoの設定
    Set fso = CreateObject("Scripting.FileSystemObject")

    'ベースネームを配列変数に設定
    ReDim BaseNames(fso.getFolder(folderPath).Files.Count)

ReDim을 사용하고 있습니다만, 이것은 처리중에 변수를 늘리고 싶은 경우에 사용합니다. 이번 경우는 BaseName(1),BaseName(2),BaseName(3) 라고 늘려 갈 수 있습니다.

폴더 경로 설정

    'フォルダ内のファイルへとパスを繋ぐ
    For Each file In fso.getFolder(folderPath).Files

        cnt = cnt + 1

        'ベースネームにファイル名を割り当てる
        BaseNames(cnt) = fso.GetBaseName(file.Name)

주문 번호 및 구매자 추출

            str1 = Split(BaseNames(cnt), "注文書")

            '発注ナンバーをセルへ表示
            Cells(cnt + 1, 1) = Mid(str1(1), 1, 6)

　　　　　　　'残った文字列から不要な情報を取り除く
            str2 = Split(str1(1), "(")
            str3 = Split(str2(1), ")")
            str4 = Split(str3(0), "2")

           '発注者をセルへ表示
            Cells(cnt + 1, 2) = Split(str4(0), "2")

이 코드에서 BaseNames(cnt)는 파일 이름을 그대로 값으로 포함하므로 필요하지 않은 정보를 제거합니다.

구매처 추출

            'フォルダパスとファイル名を足すことでファイルパスを設定する
            SetFile = folderPath & "\" & BaseNames(cnt)

            '選択中のワークブックを開く（厳密には開かないで中身を参照する）
            Set wb = ex.Workbooks.Open(Filename:=SetFile, UpdateLinks:=0, ReadOnly:=True, IgnoreReadOnlyRecommended:=True)

                '発注先をコピーする
                wb.Worksheets(1).Range("A6").Copy

                '発注先を張り付ける
                wbMoto.Worksheets(1).Cells(cnt + 1, 3).PasteSpecial xlPasteFormulasAndNumberFormats

                'コピーした内容を空に戻す
                Application.CutCopyMode = False

Dim ex As New Excel.Application
ex.Workbooks.Open(...)이 두 구문으로 새로 열리는 파일을 엑셀로 취급하도록 설정합니다.
ReadOnly:=True, IgnoreReadOnlyRecommended:=True　이 코드로 열리는 엑셀 데이터를 읽기 전용 [읽기 전용]으로 설정합니다.
※메리트:파일을 열지 않고 내용을 참조할 수 있으므로 매우 처리가 빨라진다
※단점:열린 파일의 내용의 편집은 할 수 없다

[최대 소계의 산출]

최대 소계 추출

           Dim Buf As Long 　'Bufは最大小計を入れるオブジェクト

　　　　　　　'最大小計を算出する範囲
            For j = 12 To 26

　　　　　　　　　'もしBuf(最大小計)の値よりセルの値が大きい場合
                If Buf < wb.Worksheets(1).Cells(j, 5) Then

　　　　　　　　　　　'Bufの値を更新する(セルの値が入る)
                    Buf = wb.Worksheets(1).Cells(j, 5)
                End If
            Next j

            '集計用のシートに最大小計（金額）を入力する
            wbMoto.Worksheets(1).Cells(cnt + 1, 5) = Buf

            '集計用のシートに最大小計（品目）を入力する
            For j = 12 To 26
                If wb.Worksheets(1).Cells(j, 5) = Buf Then

　　　　　　　　　　　'最大小計のセルのA列（品目）の値を入れる
                    wbMoto.Worksheets(1).Cells(cnt + 1, 4) = wb.Worksheets(1).Cells(j, 1)
                End If
            Next j

　　　　　　　'最大小計の値を初期化する（次の注文書でもBufを使用するため）
            Buf = 0

금액의 표시를 정돈한다

    Range("E2 : E51").NumberFormatLocal = "#,###"
    Range("G2 : G61").NumberFormatLocal = "#,###"

그러면 VBA의 기본 조작(응용 2)에 계속됩니다!