VBAを使用して同じ値に基づいてセルのグループを選択する

Question

同じ値を持つセルのグループを選択して色付けするVBAコードを書きたいと思います。行A、スタッフIDについては

MySpreadSheet

、同じですが、同じ人のために、私はそれらをスキャンしようとすると、それらが同じであれば、あなたが見水色の色でセルを埋めます現在の地域の列Aから列CのMaxColumnまで、

私はコードを作成しましたが、実行するときに何もしません。すべてのヘルプは理解されるであろう。

Sub ActualColouring() 

Dim SerialNumber As Integer 

SerialNumber = 2                       'this variable will be assign to the rows, ignore the header, start from 2 

Do While Cells(1, SerialNumber).Value <> ""             'keep looping as long as cell is not blank 
    If Cells(1, SerialNumber).Value = Cells(1, SerialNumber + 1).Value Then  'if the value of the cell is the same as the cell below, then 
     Cells(1, SerialNumber).Select                 'then select it 
     With Selection.Interior                    'this line is the start of the fill colouring 
      .Pattern = xlSolid 
      .PatternColorIndex = xlAutomatic 
      .ThemeColor = xlThemeColorAccent1 
      .TintAndShade = 0.799981688894314 
      .PatternTintAndShade = 0 
     End With                        'end of fill colouring function 
    End If 
    SerialNumber = SerialNumber + 1                'move to the next cell 
Loop                            'loop until the end of current region 
End Sub 

Answer 1

Qualify the objectsとavoid select

Sub ActualColouring() 

Dim ws as Worksheet 
Set ws = ThisWorkbook.Worksheets("mySheet") ' change name as needed 

With ws 

    Dim SerialNumber As Long, lRow as Long 
    lRow = .Range("A" & .Rows.Count).End(xlup).Row 

    For SerialNumber = 2 to lRow                        

     If .Cells(1, SerialNumber).Value = .Cells(1, SerialNumber + 1).Value Then  
      With .Cells(1, SerialNumber).Interior 
       .Pattern = xlSolid 
       .PatternColorIndex = xlAutomatic 
       .ThemeColor = xlThemeColorAccent1 
       .TintAndShade = 0.799981688894314 
       .PatternTintAndShade = 0 
      End With                         
     End If 
    Next 

End With 

End Sub