| |
回答が付きませんね〜。
比較の対象がセルの値のみでいいと言うことであれば、
次のような考えではどうですか？
第３のシートに、二つのシートの値を比較する数式を書いて、
その結果で判断するとかです。
比較した結果をどんな形でアウトプットするのか不明ですが、
以下のサンプルでは、異なる値のセルの背景色を黄色に色付けします。
Sub セル同士の比較()
Dim wb1 As Workbook, wb2 As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim tmpSht As Worksheet, tmpR As Range
Dim r As Range
Dim cnt As Long, v() As String, x As Variant
Set wb1 = Workbooks("book1.xls")
Set wb2 = Workbooks("book2.xls")
Set tmpSht = ThisWorkbook.Worksheets.Add
For Each ws1 In wb1.Worksheets
On Error Resume Next
Set ws2 = wb2.Worksheets(ws1.Name)
On Error GoTo 0
If Not ws2 Is Nothing Then
With ws1
' Set tmpR = Intersect(.UsedRange, .Range(ws2.UsedRange.Address))
Set tmpR = .Range(.UsedRange, .Range(ws2.UsedRange.Address))
End With
' If tmpR Is Nothing Then Exit Sub
With tmpSht
.Cells.ClearContents
With .Range(tmpR.Address)
.FormulaR1C1 = "=IF('[" & ws1.Parent.Name & "]" & ws1.Name & "'!RC=" _
& "'[" & ws2.Parent.Name & "]" & ws2.Name & "'!RC,"""",1)"
cnt = Application.WorksheetFunction.Count(.Cells)
If cnt > 0 Then
v = Split("")
For Each r In .SpecialCells(xlCellTypeFormulas, xlNumbers).Areas
ReDim Preserve v(UBound(v) + 1)
v(UBound(v)) = r.Address(0, 0)
Next
End If
End With
End With
If cnt > 0 Then
On Error Resume Next
For Each x In v
ws1.Range(x).Interior.Color = vbYellow
ws2.Range(x).Interior.Color = vbYellow
Next
On Error GoTo 0
End If
Debug.Print ws1.Name, IIf(cnt > 0, cnt & " 個の相違セルがあります。", "相違セルはなし")
Set ws2 = Nothing
End If
Next
Application.DisplayAlerts = False
tmpSht.Delete
Application.DisplayAlerts = True
End Sub
|
|
arajin
- 09/9/8(火) 23:09 -
