Excel VBA循环以根据列标题填充列

时间:2017-08-17 23:42:21

标签: excel vba excel-vba

所以我有一个每天从SQL数据库更新的数据透视表。我想强调整个部分,即天> 5,但由于数据每天更新,条件格式不起作用。我创建了一个动态范围(见下文),现在我需要它来运行循环来查找第29列(名称旁边的天数)大于5的位置我需要下面的所有内容以红色突出显示,如附件所示。任何帮助或建议?我知道这很复杂。

CODE:

Sub dynamicRange()

    'Disable certain Excel featured whilst Macro is running
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    Application.ScreenUpdating = False

    'Declare variables
    Dim startCell As Range, lasRow As Long, lastCol As Long, ws As Worksheet

    'Set Objects
    Set ws = Sheet4
    Set startCell = Range("N30")

        'Find last row and column of data
        lastRow = ws.Cells(ws.Rows.Count, startCell.Column).End(xlUp).Row
        lastCol = ws.Cells(startCell.Row, ws.Columns.Count).End(xlToLeft).Column

        'Select dynamic ramge of data
        ws.Range(startCell, ws.Cells(lastRow - 1, lastCol - 1)).Select


    'Re-enable certain Excel features after macro has run
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True

enter image description here

1 个答案:

答案 0 :(得分:1)

如何,这应该为你完成工作。只需将ws变量分配给要运行的工作表即可。如果您有任何问题,请告诉我。

Sub ColorFill()
Dim ws As Worksheet
Dim rngColor As Range, rngHeader
Dim lastRow As Long, lastCol As Long, firstRow, firstCol

'Set Sheet to desired sheet
Set ws = Sheet1

'find top left of range
firstRow = ws.UsedRange.Row
firstCol = ws.UsedRange.Column

'find bottom right of range
lastRow = firstRow + ws.UsedRange.Rows.Count - 1
lastCol = firstCol + ws.UsedRange.Columns.Count - 1

'set range of headers
Set rngHeader = Range(Cells(firstRow, firstCol + 1), Cells(firstRow, lastCol))

'loop through range of headers and color column
For Each cell In rngHeader
If cell.Value > 5 Then
    Set rngColor = Range(cell.Offset(1, 0), Cells(lastRow, cell.Column))
    rngColor.Interior.ColorIndex = 3
End If
Next

End Sub