【VBAマッチング処理】リストも自動発行してみた

システム開発メーカー勤務

エクセルマクロでマッチング処理をして、リストを自動発行したい

上記のお悩みを解決します。

それでは本題に入ります。

『エクセルマクロVBAで大量データを比較・照合してマッチングする方法』を一部参考にさせていただきました。
ありがとうございます。

筆者はこんな人

中小企業の小規模情シス（総員2名）勤務歴まもなく10年目。
特技はSSD換装。

職場で日経パソコンや日経コンピュータを読み漁る日々。
おかげで、最新のパソコン機器やデバイスの知識は常にアップデート状態。

私が雑誌に読みふける一方で、取引先のシステム開発メーカーの方はプログラム作成・修正に追われている。
次第に、システム開発メーカーの中堅の方を憂うようになる。

システム開発屋さんから情シスに転職したい方の手助けをするためにブログを立ち上げた。
狙うは『中小企業の小規模情シス』。

一度きりしかない人生を少しでもより良いものにしませんか？

VBAでマッチング処理をしてデータ抽出する

F列を正として、F列には有るがB列には無いものを抽出してリストを発行します。

抽出データがある場合、メッセージボックス出力。

発行されるマッチングリストはこんな感じ。

マッチングマクロ（リスト発行機能付き）

Sub マッチング処理()

'______________________________マッチング処理開始______________________________


'B列ソート（ソートしておかないとマッチングが上手くできないと考えています。）

    With ActiveSheet.Sort
       .SortFields.Clear
       .SortFields.Add Key:=Range("B2"), SortOn:=xlsortonvalue, Order:=xlAscending
       .SetRange ActiveSheet.UsedRange
       .Header = xlYes
       .Apply
    End With

    
'E_F列ソート

    With ActiveSheet.Sort
       .SortFields.Clear
       .SortFields.Add Key:=Range("E2"), SortOn:=xlsortonvalue, Order:=xlAscending
       .SortFields.Add Key:=Range("F2"), SortOn:=xlsortonvalue, Order:=xlAscending
       .SetRange ActiveSheet.UsedRange
       .Header = xlYes
       .Apply
    End With


'マッチング処理

    Dim work1 As Worksheet
    Dim checkwork As Range
    Dim CheckedSide, CheckSide, CheckOmission, i2, PrintFlg As Long
    
    Set work1 = Worksheets("Sheet1")
    
    CheckedSide = work1.Cells(Rows.Count, "B").End(xlUp).Row        'B列（チェックされる側＝誤）の最終行を取得
    CheckSide = work1.Cells(Rows.Count, "F").End(xlUp).Row            'F列（チェックする側＝正）の最終行を取得
    
    CheckOmission = CheckedSide + 1 'B列（チェックされる側）に漏れ分を追加する行を指定
    
    For i2 = 2 To CheckSide
    
        Set checkwork = work1.Columns("B").Find(What:=work1.Cells(i2, "F"), LookIn:=xlFormulas, _
        LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)     '【肝ポイント】xlWhole＝検索テキスト全体を検索。xlPart＝検索テキストの一部を検索。
                                                                  
                                                                   
        
            If checkwork Is Nothing Then    　　　　                                  'F列には存在するが、B列に存在しない場合の処理
                work1.Cells(CheckOmission, "A") = work1.Cells(i2, "E")      '追加する文字セット（今回の例で言えば、名前）
                work1.Cells(CheckOmission, "B") = work1.Cells(i2, "F")      '追加する文字セット（今回の例で言えば、車番）
                work1.Range("B" & CheckOmission).Interior.ColorIndex = 6    '追加した車番が目立つように塗りつぶす（黄色）
                'MsgBox "未登録です→　" & work1.Cells(i2, "E") & work1.Cells(i2, "F")'←使えそうなら使ってみてね（件数が増えるとOKボタン押下が大変w）
                
                CheckOmission = CheckOmission + 1
                
                PrintFlg = 1   'マッチングリストを発行する場合のフラグをセット
                
            End If
    Next i2                                                        'F列（チェックする側＝正）の最終行まで処理実行
    
    
    
'______________________________以下、未登録リストを作成______________________________


'不要列を削除

    MaxRow2 = Range("A1").End(xlDown).Row
    delrow = MaxRow2 - 2
    
    Rows("1:" & delrow).Select
    Selection.Delete Shift:=xlUp
    
    
'項目名を追記
    
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "名前"
    
    
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "車番"
    
    
'列幅の調整
    
    Columns("A:A").Select
    Selection.ColumnWidth = 20
    
    Columns("B:B").Select
    Selection.ColumnWidth = 12
    
    
'B列をセンター揃え
    
    Columns("B:B").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    
    
'E_F列を削除

    Columns("E:F").Select
    Selection.Delete Shift:=xlToLeft
    
    
'罫線を引く

    work1.Range("B2").CurrentRegion.Borders.LineStyle = xlContinuous
    
    
'______________________________以下、未登録リスト印刷処理______________________________
    
    
    If PrintFlg = 1 Then 'マッチングリストが有る場合の処理
    
       MsgBox "※未登録あり！リストを印刷します"
       
       
    With ActiveSheet.PageSetup 'ヘッダー＆プリント設定（A4縦）
     .Orientation = xlPortrait
     .PaperSize = xlPaperA4
     .LeftHeader = "&""ＭＳ Ｐ明朝,標準""&15 " & "　未登録リスト"
     .Zoom = False
     .FitToPagesWide = 1
     .FitToPagesTall = 1
    End With
    
    'ActiveSheet.PrintOut

       
       Else
       
        'マッチングリストが無い場合の処理を記述してください
       
    End If
    
End Sub

筆者

本マクロの肝ポイントをご説明します

最初に並べ替えしておくこと

マッチング処理の肝ポイントはB列、E列、F列を『並べ替え』をしておくことです。

マッチングのときに問題となるのが『空白セル』の存在です。
そのため、空白セルを並べ替え処理で排除してあげることが大事です。

ソースの一部抜粋です。
空白セルを無視してソートしています。（ソートとソースがこんがらがる笑）

'B列ソート（ソートしておかないとマッチングが上手くできないと考えています。）

    With ActiveSheet.Sort
       .SortFields.Clear
       .SortFields.Add Key:=Range("B2"), SortOn:=xlsortonvalue, Order:=xlAscending
       .SetRange ActiveSheet.UsedRange
       .Header = xlYes
       .Apply
    End With

    
'E_F列ソート

    With ActiveSheet.Sort
       .SortFields.Clear
       .SortFields.Add Key:=Range("E2"), SortOn:=xlsortonvalue, Order:=xlAscending
       .SortFields.Add Key:=Range("F2"), SortOn:=xlsortonvalue, Order:=xlAscending
       .SetRange ActiveSheet.UsedRange
       .Header = xlYes
       .Apply
    End With

まとめ

手作業でマッチング処理をされている場合は、本記事でご紹介したマクロを使うことでかなりの時間とミスを削減することが可能です。
あなたの業務効率化に繋がれば幸いです。以上です。

※本記事でご紹介しているマクロは必ず自己責任で実行してください。

マクロボタンを図形で作成していませんか？マクロボタンはフォームで作成するほうがカッコいいですよ

あわせて読みたい

【マクロボタンを印刷しない方法】ポイントと注意点まとめ マクロボタンを印刷しない方法を教えてほしい 上記のお悩みを解決します。 本記事の内容 フォームコントロールでマクロボタンを作成して、印刷させない方法 本記事を読…