VBAサンプル
=========================================================
=== 開始!!================================================
=========================================================
Sub 差分抽出マクロ()
'**************************************************
'*** 【概要】
'*** 指定した2つのエクセル(シート)の差分を出す
'**************************************************
'*************************************************************
'*** 1.定義
'*************************************************************
'分割用
Dim Spt() As String
Dim S As String
'ファイル名
Dim new_name As String
Dim old_name As String
'縦横
Dim tate As Variant
Dim yoko As Variant
'カウント
Dim cnt As Variant
'*************************************************************
'*** 2.初期処理
'*************************************************************
'画面非表示
Application.ScreenUpdating = False
'@WK・結果用のシートをクリアする。
Sheets("新").Select
Selection.Delete Shift:=xlUp
Sheets("旧").Select
Selection.Delete Shift:=xlUp
Sheets("差分結果").Select
Selection.Delete Shift:=xlUp
'入力値の設定
Sheets("メイン").Select
new_ex = Cells(6, "D")
nex_sh = Cells(7, "D")
old_ex = Cells(10, "D")
old_sh = Cells(11, "D")
tate_max = Cells(14, "D")
yoko_max = Cells(15, "D")
'ファイル名の取得(NEWとOLD共に)
S = new_ex
Spt = Split(S, "\")
Max = UBound(Spt)
new_name = Spt(Max)
S = old_ex
Spt = Split(S, "\")
Max = UBound(Spt)
old_name = Spt(Max)
'*************************************************************
'*** 3.メイン処理
'*************************************************************
'@エクセルを開く
Workbooks.Open FileName:=new_ex
Workbooks.Open FileName:=old_ex
'A新のコピー処理
'***コピー
Windows(new_name).Activate
Cells.Select
Application.CutCopyMode = False
Selection.Copy
'***貼り付け
Windows("エクセル差分抽出.xlsm").Activate
Sheets("新").Select
Cells.Select
ActiveSheet.Paste
'B旧のコピー処理
'***コピー
Windows(old_name).Activate
Cells.Select
Application.CutCopyMode = False
Selection.Copy
'***貼り付け
Windows("エクセル差分抽出.xlsm").Activate
Sheets("旧").Select
Cells.Select
ActiveSheet.Paste
'C必要ないので閉じる。
Application.CutCopyMode = False '※事前にクリップボードの情報をクリアしておく
Workbooks(new_name).Close SaveChanges:=False
Workbooks(old_name).Close SaveChanges:=False
'D差の確認(A1から、指定の行列をチェックする
tate = 1
yoko = 1
cnt = 0
Do Until tate > tate_max
yoko = 1
Do Until yoko > yoko_max
'差分の判定
If Sheets("新").Cells(tate, yoko) = Sheets("旧").Cells(tate, yoko) Then
Else
Sheets("差分結果").Cells(tate, yoko) = Sheets("新").Cells(tate, yoko) & "【【←(新)||(旧)→】】" & Sheets("旧").Cells(tate, yoko)
cnt = cnt + 1
End If
yoko = yoko + 1
Loop
tate = tate + 1
Loop
'E結果(差分数)の出力
Sheets("メイン").Select
Cells(18, "D") = cnt
Cells(1, "A").Select
'F終了処理(画面を表示して、結果を表示)
Application.ScreenUpdating = True
MsgBox ("差分件数:" & cnt & "件になります")
End Sub
=========================================================
=== 終了!!================================================
=========================================================