\ 最大10%ポイントアップ! / 詳細を見る

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

筆者イチオシのデバイス

最近、購入して大満足しているデバイスは『DS224+(NAS)』

DS224+の内容物
筆者

Googleフォトが有料化になってから、家族の写真・動画の保存場所に困っていました・・・。
Amazonフォトも写真は無制限だけど、動画は制限あるし・・・。

そこで、自宅に導入したのが『DS224+』!
GoogleフォトやAmazonフォトと使い勝手は、ほぼ同等レベルだと感じています。

機能もすごい!

  • 場所検索
  • 人物検索
  • 年月日検索
  • ビデオのみの抽出
  • iPhone・スマホからのアップロード・閲覧可能

GoogleフォトやAmazonフォトで課金するか悩まれている方はちょっと待って!

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

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

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

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

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

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

目次

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

まとめ

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

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

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

筆者

仕事で得た知識をもとに自宅にゲーミングルームをつくっちゃいました

\34インチ湾曲ウルトラワイドモニター没入感ハンパナイ/

1000Rの湾曲ウルトラワイドモニターでグランツーリスモ7をやってみた

本業情シスの私が、厳選しまくって選んだのが湾曲率1000R34インチウルトラワイドモニター。
自分だけのプライベート空間で、圧倒的没入感を感じてみたい方には特にオススメします。

/本業情シスの私がセッティングした自慢のゲーミングルームをみてみる\

Twitterでみんなに知らせる!
  • URLをコピーしました!

この記事を書いた人

らもさんのアバター らもさん 中小企業情シス10年目

趣味はゴルフで地球を叩くのが大得意
最近は、Instagramにも力を入れて動画編集の勉強中
6つの独自ドメインで6つのブログの管理人(他にもnote、X旧Twitter)

完全にキャパオーバーで目が回ってる
けど、仕事もゲームもブログもアニメも超楽しい!

好きなアニメは、ちいかわ
好きな映画は、ラストアクションヒーロー

目次