Question

我想写一个VBA代码来选择一组具有相同值并为其着色的单元格。

对于行A，员工ID，是相同的，对于同一个人，我打算扫描它们，如果它们是相同的，请填充您在上图中看到的浅蓝色单元格，对于A列到当前地区的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

使用VBA基于相同的值选择一组单元格

1 个答案: