VBA

【VBA】同じ様式を1つのエクセルブックのシートにまとめるときに、自動でリネームしてまとめる

公務員的な事務では1日に100回くらいは見ることになる風景ですが、こんな感じに同じ様式のエクセルがフォルダ内に転がっている状態があります。

比較や串刺しをする際、1つのブックにまとめるとやりやすいのでコピーします。

今回はコピーする際にシート名を自動で設定するマクロです。

この渋谷区、新宿区、世田谷区の様式を

このようにするイメージです。

Function SetSheetsName(ByVal fileName As String) As String
'-----------------------------------------
'
'ファイル名に自治体名が入っていれば
'01千代田区のようなシート名にする。
'
'-----------------------------------------
    
     If InStr(fileName, "千代田") > 0 Then
         SetSheetsName = "01千代田区"
     ElseIf InStr(fileName, "中央") > 0 Then
         SetSheetsName = "02中央区"
     ElseIf InStr(fileName, "港") > 0 Then
         SetSheetsName = "03港区"
     ElseIf InStr(fileName, "新宿") > 0 Then
         SetSheetsName = "04新宿区"
     ElseIf InStr(fileName, "文京") > 0 Then
         SetSheetsName = "05文京区"
     ElseIf InStr(fileName, "台東") > 0 Then
         SetSheetsName = "06台東区"
     ElseIf InStr(fileName, "墨田") > 0 Then
         SetSheetsName = "07墨田区"
     ElseIf InStr(fileName, "江東") > 0 Then
         SetSheetsName = "08江東区"
     ElseIf InStr(fileName, "品川") > 0 Then
         SetSheetsName = "09品川区"
     ElseIf InStr(fileName, "目黒") > 0 Then
         SetSheetsName = "10目黒区"
     ElseIf InStr(fileName, "大田") > 0 Then
         SetSheetsName = "11大田区"
     ElseIf InStr(fileName, "世田谷") > 0 Then
         SetSheetsName = "12世田谷区"
     ElseIf InStr(fileName, "渋谷") > 0 Then
         SetSheetsName = "13渋谷区"
     ElseIf InStr(fileName, "中野") > 0 Then
         SetSheetsName = "14中野区"
     ElseIf InStr(fileName, "杉並") > 0 Then
         SetSheetsName = "15杉並区"
     ElseIf InStr(fileName, "豊島") > 0 Then
         SetSheetsName = "16豊島区"
     ElseIf InStr(fileName, "北区") > 0 Then
         SetSheetsName = "17北区"
     ElseIf InStr(fileName, "荒川") > 0 Then
         SetSheetsName = "18荒川区"
     ElseIf InStr(fileName, "板橋") > 0 Then
         SetSheetsName = "19板橋区"
     ElseIf InStr(fileName, "練馬") > 0 Then
         SetSheetsName = "20練馬区"
     ElseIf InStr(fileName, "足立") > 0 Then
         SetSheetsName = "21足立区"
     ElseIf InStr(fileName, "葛飾") > 0 Then
         SetSheetsName = "22葛飾区"
     ElseIf InStr(fileName, "江戸川") > 0 Then
         SetSheetsName = "23江戸川区"
     'ファイル名に市町村名を含まない場合は末尾10文字をシート名にする
     Else
        'シート名に使えない文字列が含まれていれば削除する
        fileName = DeleteInvalidChars(fileName)
        SetSheetsName = Right(fileName, 10)
     End If
    
End Function

Function DeleteInvalidChars(fileName As String) As String
'シート名で扱えない文字列が含まれているときは削除する

    Dim invalidChars As String
    Dim i As Long

    invalidChars = "/\?*:[]"
    DeleteInvalidChars = fileName ' 元のファイル名を初期値として設定
    
    For i = 1 To Len(invalidChars)
        DeleteInvalidChars = Replace(DeleteInvalidChars, Mid(invalidChars, i, 1), "")
    Next i
    
End Function

Function SelectExcelFile() As String
    Dim filePath As String
    
    ' ファイルの選択ダイアログを表示し、ファイルパスを取得
    filePath = Application.GetOpenFilename("Excelファイル (*.xls; *.xlsx), *.xls; *.xlsx")
    
    ' ダイアログがキャンセルされた場合は処理を終了
    If filePath = "False" Then
        Exit Function
    Else
        SelectExcelFile = filePath
    End If

End Function

Sub Test()

    Dim filePath As String
    Dim sourceWorkbook As Workbook
    Dim sourceSheet As Worksheet
    
    filePath = SelectExcelFile()
    
    Set sourceWorkbook = Workbooks.Open(filePath)
    Set sourceSheet = sourceWorkbook.Sheets(1)
    
    ' 新しいシートを作成し、選択したファイルの1番目のシートをコピー
    sourceSheet.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = SetSheetsName(filePath)
    
    ' 選択したファイルを閉じる（保存しない）
    sourceWorkbook.Close SaveChanges:=False

End Sub

エクセルのシート名に使えない文字を消すDeleteInvalidChars()、ファイル選択ダイアログを表示するSelectExcelFile()を別に定義しています。

何度か作ってみるとわかりますが、シートをコピーするという処理はエラーがよく出る処理です。

名前のエラーや、セルの名前重複、エクセルのバージョン、非表示のセルがあるといった感じです。

結局手作業の方が早いじゃん！となりがちですが、エラーハンドリングを覚えてがんばりましょう。（追々紹介します）

応用編はこちらです。

関連記事【VBA】同じ様式を1つのエクセルブックのシートにまとめるときに、自動でリネームしてまとめる（キーワードで一撃編）

ChatGPTさんによる超親切コード解説

Sub Test()

  1. Dim filePath As String
    • この行は変数 filePath を宣言します。この変数は後でExcelファイルのパスを保存するのに使われます。
  2. Dim sourceWorkbook As Workbook
    • sourceWorkbook という名前のWorkbook型の変数を宣言します。これは開かれるExcelファイルを参照するために使われます。
  3. Dim sourceSheet As Worksheet
    • sourceSheet という名前のWorksheet型の変数を宣言します。これは後で特定のExcelシートを参照するのに使われます。
  4. filePath = SelectExcelFile()
    • SelectExcelFile 関数を呼び出して、ユーザーが選択したExcelファイルのパスを filePath 変数に代入します。
  5. Set sourceWorkbook = Workbooks.Open(filePath)
    • filePath 変数に格納されたパスでExcelファイルを開き、そのファイルを sourceWorkbook という変数に関連付けます。
  6. Set sourceSheet = sourceWorkbook.Sheets(1)
    • sourceWorkbook の最初のシートを sourceSheet という変数に設定します。
  7. sourceSheet.Copy After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    • sourceSheet をコピーし、現在開いているワークブック（ThisWorkbook）の最後のシートの後に挿入します。
  8. ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count).Name = SetSheetsName(filePath)
    • 現在のワークブックの最後のシート（新しく挿入されたシート）の名前を SetSheetsName 関数を使用して設定します。この関数は filePath を引数に取り、適切なシート名を返します。
  9. sourceWorkbook.Close SaveChanges:=False
    • sourceWorkbook （先に開いたワークブック）を閉じますが、変更は保存されません（SaveChanges:=False）。

これらの行は、特定のExcelファイルを開き、その内容を現在のワークブックにコピーし、新しいシートに名前を付け、最後に元のファイルを閉じる一連の手順を表しています。

Function SetSheetsName(fileName As String) As String

  1. If InStr(fileName, “千代田”) > 0 Then
    • InStr 関数を使用して、fileName の中に “千代田” という文字列が存在するかをチェックします。存在すれば、その位置を返します（0より大きい値）。ここでの条件は、”千代田” が含まれているかどうかを確認するものです。
  2. SetSheetsName = “01千代田区”
    • もし “千代田” がファイル名に含まれている場合、関数は “01千代田区” という文字列を返します。これが新しいシートの名前になります。
  3. ElseIf InStr(fileName, “中央”) > 0 Then
    • ここでは “中央” という文字列が fileName に含まれているかをチェックします。
  4. SetSheetsName = “02中央区”
    • “中央” が含まれている場合、シート名を “02中央区” に設定します。

(以降の ElseIf ブロックも同様のパターンで、異なる自治体名に対応する異なるシート名を返します。)

Function DeleteInvalidChars(fileName As String) As String

  1. Dim invalidChars As String
    • invalidChars という文字列型の変数を宣言します。この変数は、後でシート名に使用できない文字を格納するために使われます。
  2. Dim i As Long
    • i という長整数型の変数を宣言します。これはループでのカウンターとして使われます。
  3. invalidChars = “/?*:[]”
    • シート名に使用できない文字を invalidChars 変数に設定します。
  4. DeleteInvalidChars = fileName
    • 関数の返り値を初期設定として fileName に設定します。
  5. For i = 1 To Len(invalidChars)
    • invalidChars の各文字に対してループを開始します。
  6. DeleteInvalidChars = Replace(DeleteInvalidChars, Mid(invalidChars, i, 1), “”)
    • Replace 関数を使用して invalidChars の各文字を空文字に置換します。これにより、無効な文字がファイル名から削除されます。
  7. Next i
    • ループの次のイテレーションに進みます。

Function SelectExcelFile() As String

  1. Dim filePath As String
    • filePath という文字列型の変数を宣言します。これはファイル選択ダイアログから取得したファイルパスを格納するために使われます。
  2. **filePath = Application.GetOpenFilename(“Excelファイル (*.xls; *.xlsx), .xls; .xlsx”)
    • Application.GetOpenFilename メソッドを使用してファイル選択ダイアログを表示し、選択されたファイルのパスを filePath に格納します。
  3. If filePath = “False” Then
    • ユーザーがダイアログで「キャンセル」を選択した場合、filePath は “False” という文字列になります。この場合、関数から抜け出します。
  4. Exit Function
    • 関数の実行を終了します。
  5. Else
    • ユーザーがファイルを選択した場合の処理に進みます。
  6. SelectExcelFile = filePath
    • ユーザーがファイルを選択した場合、filePath に格納されたファイルパスを関数の戻り値として設定します。
  7. End If
    • If ステートメントの終了を示します。

コメントを残す

メールアドレスが公開されることはありません。 ※ が付いている欄は必須項目です

CAPTCHA