Excelおさるくんのastro-notion-blog

Option Explicit

Sub ConvertDataFormat()
    Dim wsSource As Worksheet
    Dim wsDest As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim destRow As Long

    ' ソースシートとデスティネーションシートの設定
    Set wsSource = ThisWorkbook.Sheets("修正前")
    Set wsDest = ThisWorkbook.Sheets("修正後")

    ' デスティネーションシートの初期設定
    wsDest.Cells.Clear
    wsDest.Range("A1").Value = "社員"
    wsDest.Range("B1").Value = "カテゴリ"
    wsDest.Range("C1").Value = "値"

    ' 最終行の取得
    lastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row

    ' データの変換
    destRow = 2
    For i = 2 To lastRow
        wsDest.Cells(destRow, 1).Value = wsSource.Cells(i, 1).Value
        wsDest.Cells(destRow, 2).Value = "データ分析"
        wsDest.Cells(destRow, 3).Value = wsSource.Cells(i, 2).Value
        destRow = destRow + 1

        wsDest.Cells(destRow, 1).Value = wsSource.Cells(i, 1).Value
        wsDest.Cells(destRow, 2).Value = "機械学習"
        wsDest.Cells(destRow, 3).Value = wsSource.Cells(i, 3).Value
        destRow = destRow + 1

        wsDest.Cells(destRow, 1).Value = wsSource.Cells(i, 1).Value
        wsDest.Cells(destRow, 2).Value = "ウェブ開発"
        wsDest.Cells(destRow, 3).Value = wsSource.Cells(i, 4).Value
        destRow = destRow + 1

        wsDest.Cells(destRow, 1).Value = wsSource.Cells(i, 1).Value
        wsDest.Cells(destRow, 2).Value = "データベース"
        wsDest.Cells(destRow, 3).Value = wsSource.Cells(i, 5).Value
        destRow = destRow + 1

        wsDest.Cells(destRow, 1).Value = wsSource.Cells(i, 1).Value
        wsDest.Cells(destRow, 2).Value = "システム設計"
        wsDest.Cells(destRow, 3).Value = wsSource.Cells(i, 6).Value
        destRow = destRow + 1
    Next i

    ' 終了メッセージ
    MsgBox "データの変換が完了しました。"
End Sub

Option Explicit

Sub SplitAddress()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim address As String
    Dim pattern As String
    Dim regEx As Object
    Dim matches As Object
    
    ' 処理するシートを設定
    Set ws = ThisWorkbook.Sheets("住所") ' シート名を適宜変更してください
    
    ' 最終行を取得
    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    ' 正規表現パターンを設定
    pattern = "^(.{2,3}都|.{2,3}道|.{2,3}府|.{2,3}県)(.{2,3}市|.{2,3}区|.{2,3}町|.{2,3}村)(.+)$"
    
    ' 正規表現オブジェクトを作成
    Set regEx = CreateObject("VBScript.RegExp")
    regEx.Global = False
    regEx.IgnoreCase = False
    regEx.Pattern = pattern
    
    ' 住所を分割してセルに書き込み
    For i = 2 To lastRow
        address = ws.Cells(i, 1).Value
        If regEx.Test(address) Then
            Set matches = regEx.Execute(address)
            ws.Cells(i, 2).Value = matches(0).SubMatches(0) ' 都道府県
            ws.Cells(i, 3).Value = matches(0).SubMatches(1) ' 市区町村
            ws.Cells(i, 4).Value = matches(0).SubMatches(2) ' それ以降
        End If
    Next i
    
    ' メモリを解放
    Set regEx = Nothing
    Set matches = Nothing
End Sub

Set regEx = CreateObject("VBScript.RegExp")

Set regEx = New RegExp