| |
▼hama さん：
>やりたいことは
>前シート
>ＡＢＣＤ
>あ１２
>か ４１
>さ１ ２
>
>
>後シート
>ＡＢＣＤ
>か ２１
>あ２２
>た１３４
>
>前と後のＡ列を検索してなかったら後のＡセルに色をつける
>前と後のＡ列に同じ値があったら
>Ｂセル→Ｃセル→Ｄセルと比較をしていってセルの値が違っていたら
>色をつけるとしたいのです。現状だと途中で空白セルがあると比較が
>止まってしまいます。どう記述をしていいのかもわかりません。
ということでしたら、
> Sub 後シート色づけ4()
で、だいたい合ってますね(^^)
変更か所は
●A列の値があったら その行の B〜D列 3列の値を比較する
●そのとき 途中に空白セルがあっても D列までチェックする
くらいかな？
Sub 後シート色づけ5()
Dim ws前 As Worksheet
Dim ws後 As Worksheet
Dim Ans1 As Variant
Dim Ans2 As Variant
Dim newY As Long
Dim oldY As Long
Dim x As Long
Dim foundCell As Range
Dim c As Range
Set ws前 = Worksheets("前")
Set ws後 = Worksheets("後")
ws前.Columns(1).Interior.ColorIndex = xlNone
ws後.Columns("A:E").Interior.ColorIndex = xlNone
'「後」シートのA列（の値を検索値として）でループする
For Each c In ws後.Range("A2", _
ws後.Cells(ws後.Rows.Count, 1).End(xlUp))
Ans1 = c.Value
'「後」シートのA列の値で「前」シートＡ列を検索 ◆
Set foundCell = ws前.Columns(1).Find(Ans1)
'「前」シートにみつからなければ、この値のセルを色塗り
If foundCell Is Nothing Then
c.Interior.ColorIndex = 27
Else '「前」シートにこの値があったばあい
' B列〜D列まで 値を比較・色塗りする …… ●
newY = c.Row
oldY = foundCell.Row
For x = 2 To 4 'B列〜D列
Ans2 = ws後.Cells(newY, x).Value
If ws前.Cells(oldY, x).Value <> Ans2 Then '●●
ws後.Cells(newY, x).Interior.ColorIndex = 27
End If
Next
End If
Next c
End Sub
'●● の部分は 単に空白セルだったらループを抜ける(Exit For)条件を
削除しただけですが、これだと、一方が空白セルで、他方に値があると
色塗りされます。
比較・色塗りは「空白セルでないとき」という条件をつけるなら、
そこを
If Not IsEmpty(Ans2) Then
If ws前.Cells(oldY, x).Value <> Ans2 Then
処理
End If
End If
のように直してください。
|
|
kanabun
- 13/11/12(火) 12:03 -
