エクセルVBAのループ列ヘッダ

Question

に基づいて、列を埋めるためにだから私は、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 

Answer 1

Howdeeが、これはあなたのために仕事を得る必要があります。実行したいシートに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