|
▼杏子 さん:
こんにちは
資料Aも資料Bも,マクロブックのシートに貼り付けてあるという前提です。
比較後、相違をメッセージで表示します。
Sub Sample()
Dim shA As Worksheet
Dim shB As Worksheet
Dim x As Double
Dim y As Double
Dim rA As Range, rB As Range
Dim i As Long
Dim j As Long
Dim v() As String
Dim k As Long
Dim dataA As Variant
Dim dataB As Variant
Set shA = Sheets("Sheet1") '資料A
Set shB = Sheets("Sheet2") '資料B
With shA.UsedRange
x = .Cells(.Cells.Count).Column
y = .Cells(.Cells.Count).Row
End With
With shB.UsedRange
x = WorksheetFunction.Max(x, .Cells(.Cells.Count).Column)
y = WorksheetFunction.Max(y, .Cells(.Cells.Count).Row)
End With
Set rA = shA.Range("A2", shA.Cells(y, x))
Set rB = shB.Range("A2", shB.Cells(y, x))
ReDim v(1 To rA.Count)
For i = 1 To rA.Rows.Count
For j = 1 To rA.Columns.Count
If shA.Cells(i, j).Formula <> shB.Cells(i, j).Formula Then
k = k + 1
dataA = shA.Cells(i, j).Formula
dataB = shB.Cells(i, j).Formula
If Len(dataA) = 0 Then dataA = "空白値"
If Len(dataB) = 0 Then dataB = "空白値"
v(k) = shA.Cells(i, j).Address(False, False) & " (A) " & dataA & " vs (B) " & dataB
End If
Next
Next
If k = 0 Then
MsgBox "相違はありません"
Else
ReDim Preserve v(1 To k)
MsgBox "以下の相違がありました" & vbLf & Join(v, vbLf)
End If
End Sub
|
|