こどちゃれの紹介コードを無料でゲットする!クリック!

【エクセルVBA】マッチング抽出→リスト自動発行マクロ

悩む人

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

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

本記事の内容
  • エクセルマクロで、マッチング処理→マッチングリスト発行する方法
本記事を読むメリット
  • マッチングを手作業でしている場合、本記事でご紹介しているマクロを使用すると・・・かなりの業務時間を削減することが可能だと考えています。
本記事の根拠
  • 本記事公開時点で、私はシステム開発担当7年目です
本記事を読んでほしい人
  • Excelでかっこよくマッチングリスト作成をしたい方

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

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

スポンサーリンク
目次

マッチングデータ抽出

  • B列・・・チェックされる側(誤の可能性)
  • E_F列・・・チェックする側(正)
    ※当たり前ですが、車番は私が適当に数字入力をしたものです。

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 = "&""MS P明朝,標準""&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

まとめ

ばらもん。

いかがでしたか?

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

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

お得情報!

こどもチャレンジの紹介コードを無料で公開中!

2021年8月時点で長男は、こどちゃれ1年半継続中です。

現在、なんと!私からの紹介コードを無料で公開しています!

メールアドレスを入力するだけ

こどちゃれって最悪?1年半継続して感じた3つのメリット

よかったらシェアしてね!
目次
閉じる