| |
こんにちは、Be Quit さん。
ご指摘ありがとうございます、まだ途中ですがコードは以下のとおりです。
初心者のため、見苦しい箇所はあるかと思いますが、宜しくお願いします。
（Set〜でエラーになります）
Private Sub CommandButton1_Click()
Sheets("新").Activate
Sh2EndRow = Cells(Rows.Count, "F").End(xlUp).Row
Sh1EndRow = Sheets("旧").Cells(Rows.Count, "F").End(xlUp).Row
For i = 3 To Sh2EndRow
Set FCel = Sheets("旧").Range("F2" & ":F" & Sh1EndRow).Find(Range("F" & i).Value, _
After:=Sheets("旧").Range("F2"), LookAt:=xlWhole, MatchCase:=True)
If Not FCel Is Nothing Then
SaveAd = FCel.Address
Do
If Cells(i, 6).Value = Sheets("旧").Range(FCel.Address).Value Then
Sheets("旧").Range(FCel.Address).Interior.Pattern = xlGray16
Sheets("差分").Range("B" & i & ":G" & i).Value = Range("B" & i & ":G" & i).Value
For q = 2 To 27
If Cells(i, q + 6).Value <> Sheets("旧").Range(FCel.Address).Offset(0, q).Value Then
Range("F" & i).Offset(0, q).Interior.Pattern = xlGray16
Sheets("差分").Cells(i, q + 6).Value = Sheets("旧").Range(FCel.Address).Offset(0, q).Value - Range("F" & i).Offset(0, q).Value
Else
Sheets("差分").Cells(i, q + 6).Value = 0
End If
Next
End If
Set FCel = Sheets("旧").Range("F2" & ":F" & Sh1EndRow).FindNext(FCel)
Loop Until SaveAd = FCel.Address
Set FCel = Nothing
Else
With Range("B" & i & ":AH" & i).Interior
.ColorIndex = 37
.PatternColorIndex = xlAutomatic
Sheets("差分").Range("A" & i & ":AH" & i).Value = Range("A" & i & ":AH" & i).Value
Sheets("差分").Range("AH" & i).Value = "追加"
End With
End If
Next
Set FCel = Nothing
Sheets("差分").Activate
End Sub
|
|
