(Excelマクロ)識別IDから対象行を特定する

このマクロは、以下の動作を実現します。

  • 識別IDがあれば、画像のように列や行の途中に空白があるファイルであっても特定の結果を出力する





また、このマクロには以下のような特徴があります。

  • 列数/行数をExcelの限界値ぎりぎりまで増やしても動作する
  • 項目名の順番が入れ替わってもどこかに識別IDの列さえあれば問題ない

コード

具体的なコードは以下の通りです。解説の必要な部分については、後述します。

Option Explicit
Option Base 1

Public Sub Sample()

Dim tmp As Variant
Dim SearchValue As String

Dim Items() As String
ReDim Items(Range("AZ1").End(xlToLeft).Column) ''6
Dim InfoColumn(1 To 3) As Long

Dim i As Long
Dim IDColumn As Long
For i = LBound(Items) To UBound(Items) ''Lbound(Items) = 1,Ubound(Items) = 6
   Items(i) = Cells(1, i).Value '項目名は1行目にある前提
   Select Case Items(i)
   Case "識別ID"
        IDColumn = i  ''4
   Case "果物名"
        InfoColumn(1) = i  ''1
   Case "生産地"
        InfoColumn(2) = i ''3
   Case "在庫個数"
        InfoColumn(3) = i  ''6
   End Select
Next i

Select Case IDColumn
    Case 0
        MsgBox "識別IDの列が見つかりません。", vbCritical + vbOKOnly, Title:="Error"
        Exit Sub
    Case Else
        For i = 1 To 3
            InfoColumn(i) = IDColumn - InfoColumn(i)
        Next i
End Select

SearchValue = Application.InputBox("検索対象のIDを入力してください。", Title:="入力", Type:=2)
If SearchValue = "False" Then Exit Sub

For Each tmp In Range(Cells(1, IDColumn), Cells(65535, IDColumn))

If tmp.Value = SearchValue Then
    MsgBox "果物名:" & tmp.Offset(0, -InfoColumn(1)).Value & vbNewLine & _
    "生産地:" & tmp.Offset(0, -InfoColumn(2)).Value & vbNewLine & _
    "在庫個数:" & tmp.Offset(0, -InfoColumn(3)).Value, vbInformation + vbOKOnly, Title:=""
Exit Sub
End If

Next tmp

MsgBox "見つかりませんでした。", vbExclamation + vbOKOnly, Title:="見つかりません"

End Sub

ダブルクォーテーションを2つ繋げている部分は、画像の例の場合に代入される数値を示しています。

コードの説明

全体設定

Option Explicit
Option Base 1

1行目は変数の宣言の強制、2行目は配列の開始値を「1」に指定しています。

変数の定義

Dim tmp As Variant
Dim SearchValue As String
 
Dim Items() As String
ReDim Items(Range("AZ1").End(xlToLeft).Column) ''6
Dim InfoColumn(1 To 3) As Long
 
Dim i As Long
Dim IDColumn As Long

ReDim Items(Range(“AZ1”).End(xlToLeft).Column) で一番右にある列(画像の例ではF列の「6」)を取得しています。

配列の開始値を「1」に指定していないと、Itemsを再定義した際の最小の要素が「0」から始まってしまうため、次の「取得する項目名の検索」でエラーが発生します。

取得する項目名の検索

For i = LBound(Items) To UBound(Items) ''Lbound(Items) = 1,Ubound(Items) = 6
   Items(i) = Cells(1, i).Value '項目名は1行目にある前提
   Select Case Items(i)
   Case "識別ID"
        IDColumn = i  ''4
   Case "果物名"
        InfoColumn(1) = i  ''1
   Case "生産地"
        InfoColumn(2) = i ''3
   Case "在庫個数"
        InfoColumn(3) = i  ''6
   End Select
Next i

「果物名」ではなく「価格」を取得する場合は、InfoColumn(1)に「2」が代入されます。

エラー処理&識別IDからの距離の算出

Select Case IDColumn
    Case 0
        MsgBox "識別IDの列が見つかりません。", vbCritical + vbOKOnly, Title:="Error"
        Exit Sub
    Case Else
        For i = 1 To 3
            InfoColumn(i) = IDColumn - InfoColumn(i)
        Next i
End Select

InfoColumn(i) = IDColumn – InfoColumn(i)は、特定の列(InfoColumn)が識別IDからどれだけ離れているかを求めています。

たとえば、IDColumn = 4 ,InfoColumn(1) = 1 ,InfoColumn(2) = 3 ,InfoColumn(3) = 6 の場合、計算式を経た後には、InfoColumnのそれぞれの要素に対して、InfoColumn(1) = 3 , InfoColumn(2) = 1 ,InfoColumn(3) = -2 が代入されます。

入力ボックスの制御

SearchValue = Application.InputBox("検索対象のIDを入力してください。", Title:="入力", Type:=2)
If SearchValue = "False" Then Exit Sub

変数SearchValueString(文字列)型で宣言しているため、未入力の場合の判定を、If SearchValue = False Then Exit Subとすることはできません。

目的とする識別IDの検索

For Each tmp In Range(Cells(1, IDColumn), Cells(65535, IDColumn))
 
If tmp.Value = SearchValue Then
    MsgBox "果物名:" & tmp.Offset(0, -InfoColumn(1)).Value & vbNewLine & _
    "生産地:" & tmp.Offset(0, -InfoColumn(2)).Value & vbNewLine & _
    "在庫個数:" & tmp.Offset(0, -InfoColumn(3)).Value, vbInformation + vbOKOnly, Title:=""
Exit Sub
End If
 
Next tmp
 
MsgBox "見つかりませんでした。", vbExclamation + vbOKOnly, Title:="見つかりません"
 
End Sub

識別IDの列一つひとつのセルを対象として、目的とする識別IDを検索します。識別IDが見つかった場合には、メッセージボックスを表示させてマクロを終了します。12行目の「見つかりませんでした。」というメッセージボックスは、入力された識別IDが見つからなかった場合にのみ表示されます。

4~6行目は、Offsetの列の値で先頭に「マイナス」記号が付いている点に注意してください。

このマクロのカスタマイズが必要な場合

Excelで識別IDさえあれば対象行を特定できるツールより、承ります。

おすすめ

コメントを残す

メールアドレスが公開されることはありません。

このサイトはスパムを低減するために Akismet を使っています。コメントデータの処理方法の詳細はこちらをご覧ください