2016-12-07 102 views
0

我想写一个VBA代码来选择一组具有相同值和颜色的单元格。使用VBA根据相同的值选择一组单元格

MySpreadSheet

对于A行,工作人员ID,都是一样的,为同一人,我希望通过他们进行扫描,如果他们是相同的,填补了细胞与淡蓝色的颜色,你在看上面的图片,列A到当前区域的最大列。

我有一个代码来做到这一点,但是当我运行它时,它什么都不做。任何帮助将不胜感激:

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 

回答

0

Qualify the objectsavoid 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 
+0

感谢斯科特!你是一个拯救生命的人! :) –

相关问题