| |
▼ビギナー さん：
おはようございます。
><ファイル1> ＜ファイル2＞
> A B C A B C
>1 100 1 一 1 100 3 一
>2 200 2 二 2 200 2 二
>3 300 3 三 3 300 3 三
>7 700 7 七 4 500 4 四
>4 400 4 四 5 500 5 五
>5 500 5 五 6 600 6 六
>6 600 6 六
上記のように二つのブックのそれぞれのアクティブシートのセルＡ１から
データが入っているとします。
ブック名は、「Book1」、「Book2」だとします。
どちらかのブックのの標準モジュールに
'================================================================
Sub main()
Dim sht1 As Worksheet
Dim sht2 As Worksheet
Dim radd As String
Dim crng As Range
Dim diffcnt As Long
Set sht1 = Workbooks("book1").ActiveSheet
Set sht2 = Workbooks("book2").ActiveSheet
' ↑比較する開いている二つのブック名を指定する
radd = 検査セル範囲の取得(sht1, sht2)
diffcnt = 0
For Each crng In sht1.Range(radd)
With crng
If .Value <> sht2.Range(.Address).Value Then
.Interior.ColorIndex = 3
sht2.Range(.Address).Interior.ColorIndex = 4
diffcnt = diffcnt + 1
End If
End With
Next
MsgBox "相違セル個数＝ " & diffcnt
Set sht1 = Nothing
Set sht2 = Nothing
End Sub
'=========================================================================
Function 検査セル範囲の取得(sht1 As Worksheet, sht2 As Worksheet) As String
Dim r1 As Range
Dim r2 As Range
Dim mcol As Long
Dim mrw As Long
Set r1 = sht1.Range("a1").CurrentRegion
Set r2 = sht2.Range("a1").CurrentRegion
mcol = r1.Columns.Count
If mcol < r2.Columns.Count Then mcol = r2.Columns.Count
mrw = r1.Rows.Count
If mrw < r2.Rows.Count Then mrw = r2.Rows.Count
With sht1
検査セル範囲の取得 = .Range(.Cells(1, 1), .Cells(mrw, mcol)).Address
End With
Set r1 = Nothing
Set r2 = Nothing
End Function
で、Mainを実行してみてください。
ブック名は実際の名前に変更してください。
上記のコードは、二つのブックの各セルを比較して、
値が違っていれば色を付けるというアルゴリズムですが、
条件付書式を使って比較した結果、値の違うセルに色を付ける方法も
考えられます。
|
|
ichinose
- 06/1/27(金) 8:22 -
