VBAコード解説: テスト1からテスト18までのデータを新しいシートに挿入

日付:


VBAコード解説: テスト1からテスト18までのデータを新しいシートに挿入

はじめに

　VBA（Visual Basic for Applications）は、Microsoft Officeアプリケーション（Excel、Word、Outlookなど）で使用されるプログラミング言語です。この記事では、Excel VBAを使用して、特定の条件を満たす行のデータを新しいシートに挿入する方法を解説します。

課題

以下の課題を解決するためのVBAコードを作成します。

  1. シート「Sheet1」のL列には、テスト1からテスト18までの文字列を含むデータが入力されています。
  2. 最終行は不明ですが、データは1行目から記入されています。
  3. 検索文字列が「テスト1」の場合、その行のA列からK列までのデータを新しいシート「テスト1」の2行目に挿入します。
  4. 同様に、検索文字列が「テスト2」の場合は新しいシート「テスト2」に、検索文字列が「テスト3」の場合は新しいシート「テスト3」にデータを挿入します。これをテスト18まで繰り返します。

解決策

以下の手順でVBAコードを作成します。

  1. シート「Sheet1」の最終行を取得します。
  2. テスト1からテスト18までの検索文字列をループで処理します。
  3. 各検索文字列に対して、Sheet1のデータを検索し、該当する行のA列からK列までのデータを新しいシートに挿入します。
　　※ ここではテスト１～テスト１８を大分県内の市町村名で置き換えます。　

Sub InsertDataToNewSheets()
    Dim ws1 As Worksheet
    Dim wsNew As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim searchStrings As Variant
    
    ' シートを指定
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    
    ' 検索文字列の配列
    searchStrings = Array("大分市", "別府市", "中津市", "日田市", "佐伯市", "臼杵市", "津久見市", "竹田市", _
                          "豊後高田市", "杵築市", "宇佐市", "豊後大野市", "由布市", "国東市", "姫島村", _
                          "日出町", "九重町", "玖珠町")
    
    ' Sheet1の最終行を取得
    lastRow = ws1.Cells(ws1.Rows.Count, "L").End(xlUp).Row
    
    ' 検索文字列ごとに新しいシートを作成
    For i = LBound(searchStrings) To UBound(searchStrings)
        searchString = searchStrings(i)
        
        ' 新しいシートを作成
        On Error Resume Next
        Set wsNew = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
        wsNew.Name = searchString
        On Error GoTo 0
        
        ' データをコピー
        For j = 1 To lastRow
            If InStr(1, ws1.Cells(j, "L").Value, searchString) > 0 Then
                ws1.Range("A" & j & ":K" & j).Copy
                wsNew.Cells(wsNew.Rows.Count, "A").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
            End If
        Next j
        
        ' コピーしたデータを挿入
        Application.CutCopyMode = False
    Next i
End Sub