いつものExcel作業を時短・自動化して早く帰宅しよう!
TipstourではExcel時短テクニックを多数掲載しています。

 

Excel時短テクニック記事・一覧

  • VBAで都道府県ごとにシートを追加するにはどうすればいいの?
  • シートの名前は都道府県の名前にしたい
  • コピペで作業できるようにしてほしい

この記事ではExcelVBAで「単一セルに入力された住所から、都道府県ごとにシートを追加する」サンプルコードを紹介します。

記事内のサンプルコードをコピペして設定するだけで、作業の自動化が可能です。

また、このサンプルコード内の処理についても、詳しく解説しています。

ご参考までに、それではどうぞ。

 

  都道府県ごとにセルを分割する方法については、こちらの記事でご紹介しています! 合わせてどうぞ。

【ExcelVBA】都道府県・市区町村ごとにセルを分割する方法【コピペでOK】 | Tipstour

単一セルの住所全文から都道府県ごとにシートを追加する

'DATAシートを変数「dataSh」に定義
Dim dataSh As Worksheet
Set dataSh = ThisWorkbook.Worksheets("DATA")
'データの数だけループ処理
Dim i As Long
Dim fullAddress As String
Dim prefectureWordCount As Long
Dim prefectureName As String
For i = 2 To 14
    '住所全文が入力されているセルの値を変数に定義
    fullAddress = dataSh.Cells(i, 1).Value
    
    '4文字目が「県」かどうか(神奈川県、和歌山県、鹿児島県)を判定し都道府県の文字数を変数に定義
    If InStr(fullAddress, "県") = 4 Then
        prefectureWordCount = 4
    Else
        prefectureWordCount = 3
    End If
    
    '住所全文から都道府県名を取得し、変数に定義
    prefectureName = Left(fullAddress, prefectureWordCount)
    
    '都道府県シートがあるかどうか判定
    Dim flg As Boolean
    flg = False
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        If ws.Name = prefectureName Then
            flg = True
            Exit For
        End If
    Next ws
    
    '都道府県シートがない場合はシート追加
    If flg = False Then
        Dim wsCnt As Long
        wsCnt = ThisWorkbook.Worksheets.Count
        Worksheets.Add After:=ThisWorkbook.Worksheets(wsCnt)
        ActiveSheet.Name = prefectureName
    End If
Next i

▼実行前

※住所は全てダミーデータです。

▼実行後

今回のコードでは、画像のように一つのセルに入力されている住所全文から、都道府県名だけを取り出し、都道府県名を名前としたシートを追加しています。

順にコードを解説します。

単一セルの住所全文から都道府県ごとにシートを追加するコードの解説

繰り返し処理「For Next」

はじめに、今回の処理でメインとなる「For Next」について解説します。

'DATAシートを変数「dataSh」に定義
Dim dataSh As Worksheet
Set dataSh = ThisWorkbook.Worksheets("DATA")
'データの数だけループ処理
Dim i As Long
Dim fullAddress As String
Dim prefectureWordCount As Long
Dim prefectureName As String
For i = 2 To 14
    '住所全文が入力されているセルの値を変数に定義
    fullAddress = dataSh.Cells(i, 1).Value
~~~
Next i

「For Next」では、カウンターに設定した変数がループするごとに変化していきます。ここでは変数「i」がカウンターとなっており「2 To 14」つまり「2」から「14」まで変化していきます。

つまり、画像のセルから順番にデータを取得して変数「fullAddress」に住所全文を定義することになります。

  • ThisWorkbook.Worksheets("DATA").Cells(2, 1)
  • ThisWorkbook.Worksheets("DATA").Cells(3, 1)
  • ThisWorkbook.Worksheets("DATA").Cells(4, 1)
  • ThisWorkbook.Worksheets("DATA").Cells(5, 1)
  • ThisWorkbook.Worksheets("DATA").Cells(6, 1)
  • ThisWorkbook.Worksheets("DATA").Cells(7, 1)
  • ThisWorkbook.Worksheets("DATA").Cells(8, 1)
  • ThisWorkbook.Worksheets("DATA").Cells(9, 1)
  • ThisWorkbook.Worksheets("DATA").Cells(10, 1)
  • ThisWorkbook.Worksheets("DATA").Cells(11, 1)
  • ThisWorkbook.Worksheets("DATA").Cells(12, 1)
  • ThisWorkbook.Worksheets("DATA").Cells(13, 1)
  • ThisWorkbook.Worksheets("DATA").Cells(14, 1)

こうして取得した変数「fullAddress」から「都道府県」を取り出し、取り出した「都道府県」名を名前としたシートを追加する処理を繰り返しています。

住所全文から「都道府県」を取り出す

つづいて、住所全文から「都道府県」を取り出す方法を解説します。

'4文字目が「県」かどうか(神奈川県、和歌山県、鹿児島県)を判定し都道府県の文字数を変数に定義
If InStr(fullAddress, "県") = 4 Then
    prefectureWordCount = 4
Else
    prefectureWordCount = 3
End If
        
'住所全文から都道府県名を取得し、変数に定義
prefectureName = Left(fullAddress, prefectureWordCount)

まず「都道府県」を抜き出すには特徴を知る必要があります。

「都道府県」は基本的に「都」「道」「府」「県」という文字までで3文字で構成されています。

ただし、コード内のコメントにもあるように次の3つの県だけは例外です。

  • 神奈川県
  • 和歌山県
  • 鹿児島県

これら3つの県だけは、3文字ではなく4文字で抽出する必要があります。

そこで例外の判定をする必要があるのですが、全て4文字目が「県」となっていることがわかるので、この条件で分岐させ変数「prefectureWordCount」に「3」または「4」を定義します。

またここで使用しているのが「InStr」関数です。第一引数に指定した文字列内から第二引数に指定した文字を検索し、見つかった文字数を返します。

取得した「都道府県」名のシートがあるかどうかを判定

次に、取得した「都道府県」名のシートがすでに存在しているかどうかを確認する方法を解説します。

'都道府県シートがあるかどうか判定
Dim flg As Boolean
flg = False
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
    If ws.Name = prefectureName Then
        flg = True
        Exit For
    End If
Next ws

ここでポイントとなるのは、繰り返し処理「For Each」です。

「For Each」は指定した範囲内の全ての要素に対して処理を行います。ここでは、「ThisWorkbook.Worksheets」内の全ワークシート「ws」に対して処理を行っています。

そして、シートの名前「ws.Name」が「For Next」で取得した「prefectureName」と同じであったら「flg = True」として「Exit For」で繰り返し処理を抜けています。

また、はじめに解説した「For Next」処理で再度同じ処理が実行される際、「flg」の値が引き継がれるので、毎回「flg = False」として初期化する処理を入れています。

この処理で、コピーしようとしている「都道府県名」のシートがすでにワークブック内に存在しているかどうかを確認することができます。

この判定をいれずシート名の重複を確認しないと、同一のデータがあった場合、画像のエラーが出てマクロが止まってしまうので注意しましょう。

取得した「都道府県」名のシートを末尾に追加

取得した「都道府県」名のシートを末尾に追加する方法を解説します。

'都道府県シートがない場合はシート追加
If flg = False Then
    Dim wsCnt As Long
    wsCnt = ThisWorkbook.Worksheets.Count
    Worksheets.Add After:=ThisWorkbook.Worksheets(wsCnt)
    ActiveSheet.Name = prefectureName
End If

先ほど「For Each」処理で取得した、「都道府県」名のシートがあるかどうかを判定した「flg」が「False」の場合、つまり該当名称のシートがない場合にシート追加処理を実行します。

まず、現在のワークシートの枚数を「ThisWorkbook.Worksheets.Count」で取得します。例えば、画像の状態なら、「ThisWorkbook.Worksheets.Count」は「2」となります。

これを変数「wsCnt」に定義して「Worksheets.Add After:=ThisWorkbook.Worksheets(wsCnt)」とすることで、最終シートの後ろ、つまり末尾に新しくシートを追加することができます。

また、追加直後のシートは「ActiveSheet」で取得できるので、事前に取得した「prefectureName」にシート名を変更しています。

以上、コピペでできるExcelVBAでの「単一セルに入力された住所から、都道府県ごとにシートを追加する」方法の紹介でした。

コード内で解説した繰り返し処理や関数もコピペで使えますので、試してみてください。