| |
▼hama さん：
仮に、シートレイアウトが
「前」シート
銘柄 開始 安値 高値 終値
橋本 64 40 66 56
高山 80 70 90 80
岡田 63 63 91 84
平山 90 75 95 95
須藤 80 70 83 76
加藤 73 60 80 78
君島 56 56 76 70
村上 87 73 90 87
「後」シート
銘柄 開始 安値 高値 終値
岡田 63 63 93 84
加藤 73 60 80 80
橋本 64 40 66 56
君島 56 52 76 70
高山 80 67 90 80
須藤 80 66 83 76
渡辺 87 73 90 87
のようだとすると（どちらのシートも先頭は [A1]）
>ループをＡ列〜Ｄ列までにしたいのですが
は やっぱりB列〜E列まで ではありませんか(^^
↓◆が主な変更か所です
Sub 後シート色づけ4()
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列〜E列まで 値を比較・色塗りする …… ◆
newY = c.Row
oldY = foundCell.Row
For x = 2 To 5 'B列〜E列
Ans2 = ws後.Cells(newY, x).Value
If IsEmpty(Ans2) Then
Exit For
ElseIf ws前.Cells(oldY, x).Value <> Ans2 Then
ws後.Cells(newY, x).Interior.ColorIndex = 27
End If
Next
End If
Next c
End Sub
|
|
kanabun
- 13/11/12(火) 10:40 -
