【動画＆サンプル付き】2つのファイルを比較しOK / NG判定

2023 1/07

2022年10月10日 2023年1月7日

まるきち君！今日は初めて実践として2つのファイルを比較してみよう！Excel VBAならボタンひとつで実行できるよ！

ファイル比較って今まで目視でやってて時間もかかるし、疲れてるとミスりまくるんだよね～

実践記事はサンプルと動画付きだからそのまま転用することができるよ！いっしょにみていこうよ！

イッエーイ！お願いします！

サンプル＆動画
2つのファイル比較とOK / NG判定図解
定数宣言
データ消去
2つのファイルを開く
2つのファイルのデータを比較
まとめ

サンプル＆動画

サンプル＆動画はこちらになります。

ものおブログ実践1 ダウンロード

【顧客要求】製品名管理ファイルダウンロード

【ものづくり条件】製品名管理ファイルダウンロード

Sub ExcelFile_compare1()
 
    'ものおブログ実践1.xlsm内 行/列位置
    Const START_ROW As Long = 4
    Const END_ROW As Long = 21
     
    Const SEIHIN_COL As Long = 5
    Const HIKAKU1_COL As Long = 6
    Const HIKAKU2_COL As Long = 7
    Const HIKAKU3_COL As Long = 8
     
    Const JOKEN1_KOKYAKU_COL = 11
    Const JOKEN2_KOKYAKU_COL = 12
    Const JOKEN3_KOKYAKU_COL = 13
 
    Const JOKEN1_MONO_COL = 16
    Const JOKEN2_MONO_COL = 17
    Const JOKEN3_MONO_COL = 18
 
    '【顧客要求】製品名管理ファイル.xlsx 行/列位置
    Const KOKYAKU_START_ROW As Long = 1
    Const KOKYAKU_START_COL As Long = 1
 
    Const KOKYAKU_END_ROW As Long = 19
    Const KOKYAKU_END_COL As Long = 4
     
    '【ものづくり条件】製品名管理ファイル.xlsx 行/列位置
    Const MONO_START_ROW As Long = 1
    Const MONO_START_COL As Long = 1
     
    Const MONO_END_ROW As Long = 19
    Const MONO_END_COL As Long = 4
     
    Dim bkPath_FileName As String
    Dim i As Long
 
 
    '-------------データ削除-------------
 
    Call Clear_data
 
    '-------------顧客要求データのコピー-------------
         
    ChDir "C:\"
  
    bkPath_FileName = Application.GetOpenFilename("Excelファイル,*.xlsx", , "顧客要求データファイルを選択")
  
    If bkPath_FileName = "False" Then Exit Sub
      
    Workbooks.Open bkPath_FileName
     
    Range(Cells(KOKYAKU_START_ROW, KOKYAKU_START_COL), Cells(KOKYAKU_END_ROW, KOKYAKU_END_COL)).Copy _
    Destination:=ThisWorkbook.Worksheets("Sheet1").Range("J3")
     
     
    'ワークブックを閉じる
    ActiveWorkbook.Close
     
    '-------------ものづくり条件データのコピー-------------
     
    bkPath_FileName = Application.GetOpenFilename("Excelファイル,*.xlsx", , "ものづくり条件データファイルを選択")
  
    If bkPath_FileName = "False" Then Exit Sub
      
    Workbooks.Open bkPath_FileName
     
    Range(Cells(MONO_START_ROW, MONO_START_COL), Cells(MONO_END_ROW, MONO_END_COL)).Copy _
    Destination:=ThisWorkbook.Worksheets("Sheet1").Range("O3")
     
    'ワークブックを閉じる
    ActiveWorkbook.Close
 
    ThisWorkbook.Worksheets("Sheet1").Activate
 
    '製品名のコピー
    Range(Cells(START_ROW, 10), Cells(END_ROW, 10)).Copy Cells(START_ROW, SEIHIN_COL)
     
    '-----------比較処理-----------
    For i = START_ROW To END_ROW
     
        '条件1の比較
        If Cells(i, JOKEN1_KOKYAKU_COL) = Cells(i, JOKEN1_MONO_COL) Then
             
            Cells(i, HIKAKU1_COL) = "OK"
         
        Else
         
            Cells(i, HIKAKU1_COL) = "NG"
            Cells(i, HIKAKU1_COL).Interior.Color = vbRed
             
            Cells(i, JOKEN1_MONO_COL).Interior.Color = vbYellow
         
        End If
     
        '条件2の比較
        If Cells(i, JOKEN2_KOKYAKU_COL) = Cells(i, JOKEN2_MONO_COL) Then
             
            Cells(i, HIKAKU2_COL) = "OK"
         
        Else
         
            Cells(i, HIKAKU2_COL) = "NG"
            Cells(i, HIKAKU2_COL).Interior.Color = vbRed
             
            Cells(i, JOKEN2_MONO_COL).Interior.Color = vbYellow
         
        End If
     
        '条件3の比較
        If Cells(i, JOKEN3_KOKYAKU_COL) = Cells(i, JOKEN3_MONO_COL) Then
             
            Cells(i, HIKAKU3_COL) = "OK"
         
        Else
         
            Cells(i, HIKAKU3_COL) = "NG"
            Cells(i, HIKAKU3_COL).Interior.Color = vbRed
             
            Cells(i, JOKEN3_MONO_COL).Interior.Color = vbYellow
         
        End If
         
    Next i
 
End Sub
 
Sub Clear_data()
 
    ThisWorkbook.Worksheets("Sheet1").Activate
     
    Range(Cells(4, 5), Cells(1000, 8)).Clear
    Range(Cells(3, 10), Cells(1000, 18)).Clear
 
    MsgBox "データを削除しました(｀･ω･´)ゞ"
 
End Sub