比較チェックを行い、異なるセルがある場合はそのセルが赤くなるようなコードを書きました。
やりたいこと
どの列に赤いセルがあるかわかりにくいため、赤いセルがある列の先頭行を更に赤くしたいと思っております。
この場合赤くなっているセルの列のインデックスを求めて配列に入れる。
for next でループさせて先頭行を赤くする
unionで複数セルを選択して赤くしたい先頭行セルを一気に赤くする←こっちの方が早いですか？
ご教示よろしくお願いいたします。
Dim sheet() As Variant
Dim s As Long
Dim lastrow As Long
Dim lastcolumn As Long
sheet = Array("勤怠データ", "控除", "支給")
For s = LBound(sheet) To UBound(sheet)
lastrow = Sheets(sheet(s)).Cells(Rows.Count, 1).End(xlUp).Row
lastcolumn = Sheets(sheet(s)).Cells(6, Columns.Count).End(xlToLeft).column
Dim rng1 As Range, rng2 As Range
Set rng1 = Sheets(sheet(s)).Range("A6", Sheets(sheet(s)).Cells(lastrow, lastcolumn))
Set rng2 = Sheets("給与データ").Range("A1").CurrentRegion
Dim ary1() As Variant, ary2() As Variant
ary1 = rng1.Value
ary2 = rng2.Value
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")
Dim r As Long, c As Long
For r = 2 To UBound(ary1) '受入データ 2行目から最終行まで配列に格納
For c = 3 To UBound(ary1, 2) '受入データ 3列目から最終列まで配列に格納
dic(ary1(r, 2) & " " & ary1(1, c)) = ary1(r, c) '受入データkey社員番号と受入コードに紐づいた数値をiteｍとして配列に格納
Next
Next
Dim rng3 As Range
For r = 2 To UBound(ary2)
For c = 2 To UBound(ary2, 2)
If dic.Exists(ary2(r, 1) & " " & ary2(1, c)) Then 'dicに格納した社員番号と受入コードが元データと一致しているか
If dic(ary2(r, 1) & " " & ary2(1, c)) <> ary2(r, c) Then '受入データの配列に格納したデータと元データの数値に不一致があるか
If rng3 Is Nothing Then
Set rng3 = rng2.Cells(r, c) 'rngが空白の場合エラーになるためunionを使用しない
Else
Set rng3 = Union(rng3, rng2.Cells(r, c)) '不一致のセルをまとめてrng3に格納
End If
End If
End If
Next
Next
Next
If Not rng3 Is Nothing Then
rng3.Interior.Color = vbRed
End If
Dim rng4 As Range
Set rng4 = Sheets("給与データ").UsedRange
Dim cell As Range
Dim redcolumns As String
redcolumns = ""
For Each cell In rng4
If cell.Interior.Color = vbRed Then
redcolumns = cell.column & ","
End If
Next
If Len(redcolumns) > 0 Then
ary2(1, redcolumns).Interior.Color = vbRed
End If
End Sub
