| |
>>vntSheet1、vntSheet2のIDがMatchした場合、各列の値を比較し違っている時
>IDをkeyにしていますが、選択で文字もID同様にMatchしています。
>文字の場合も同様のやり方(現在、作成中）で宜しいのでしょうか。
文字の場合も同様のやり方で出来ます
ただ、今回の様に、比較する文字列の有る列が、比較する文字列をKeyとして
Sheet1、Sheet2共に昇順にソートされているのが条件です
また、「Option Compare Text」を必ず入れて下さい
Excelでソートした場合、此れを入れないと、コードの比較順と結果が変わりますので
>>また、「fncGetSheetData」のデータ取得方法が善く解らない為、
>他のデータ（文書等）もあり、空白行・列など大量にある為、
>シート全体に対し、最終行・列を取得しています。
>>各Bookのデータは、A1から有る物としてCurrentRegionで取得しています
>項目行も変更対象なので、比較対照にしています。
「Function fncGetSheetData」は、中を替えていますが
インターファイスは替えていない為、どんばさん本来のコードでも
ソートの部分を追加すれば使えると思います
>Sheet3にMatchしないセルに色を塗りたいのですが、
>最後にメッセージにてMatchしないセルに色を塗るか選択したい為、
>どの様にしたら宜しいでしょうか。
この部分の修正は、以下の様に成ります
「Sub Test7」の中で
Dim blnNoMatch As Boolean
Dim j As Long '◎追加
Dim vntNoMatch() As Variant '◎追加
Dim blnPaint As Boolean '◎追加
'Matchしないセルの色塗り選択 ◎追加
If MsgBox("Matchしないセルに色を塗ります", _
vbInformation + vbYesNo, "Paint") = vbYes Then '◎追加
blnPaint = True '◎追加
End If '◎追加
'"D:\test1.xls"からのデータ取得
If Not fncGetSheetData(vntSheet1, lngSh1Row, _
lngSh1Cln, "Sheet1") Then
'列側のデータの比較
blnNoMatch = False
j = 0 '◎追加
For i = 1 To lngSh2Cln
If vntSheet1(lngSh1Pos, i) _
<> vntSheet2(lngSh2Pos, i) Then
blnNoMatch = True
j = j + 1 '◎追加
ReDim Preserve vntNoMatch(1 To j) '◎追加
vntNoMatch(j) = i - 1 '◎追加
' Exit For '★削除
End If
Next i
'データが一致しない場合
If blnNoMatch Then
'Sheet3に行データを書き込み
ResultWrite vntSheet2, lngSh2Pos, _
lngSh2Cln, wksSheet3, lngSh3Row
If blnPaint Then '◎追加
PaintingInterior vntNoMatch, _
wksSheet3, lngSh3Row '◎追加
End If '◎追加
End If
以下のプロシージャを追加
Private Sub PaintingInterior(vntColor As Variant, _
wksWrite As Worksheet, _
lngWriteRow As Long)
' セルの色塗り
Dim i As Long
With wksWrite.Cells(lngWriteRow, 1)
For i = 1 To UBound(vntColor)
.Offset(-1, vntColor(i)).Interior.ColorIndex = 34
Next i
End With
End Sub
PS：
話は変わりますが、どんばさんが最初に書いたコード
私のコードを下敷きにしていますか？
某所のレスも見ましたが、コメントの付け方、変数名等が、
私のコードの雰囲気にソックリな物で？
|
|
Hirofumi
- 04/8/14(土) 15:07 -
