如何在宏中着色行

Question

我有一个工作宏，每6行添加一个空行，它工作的很棒！我有一个问题，虽然，这是很简单，但它不工作：S 我希望这些颜色新行颜色：.TintAndShade = -0.249977111117893和H.

只有细胞列A之间我不知道在哪里在此代码中添加此代码。有人能帮我吗？

Dim NumRowsToInsert As Long 
Dim RowIncrement As Long 
Dim ws As Excel.Worksheet 
Dim LastRow As Long 
Dim LastEvenlyDivisibleRow 
Dim i As Long 

NumRowsToInsert = 1 
RowIncrement = 6 
Set ws = ActiveSheet 
With ws 
    LastRow = .Range("A" & .Rows.Count).End(xlUp).Row 
    LastEvenlyDivisibleRow = Int(LastRow/RowIncrement) * RowIncrement 
    If LastEvenlyDivisibleRow = 0 Then 
     Exit Sub 
    End If 
    Application.ScreenUpdating = False 
    For i = LastEvenlyDivisibleRow To 1 Step -RowIncrement 
     .Range(i & ":" & i + (NumRowsToInsert - 1)).Insert xlShiftDown 
    Next i 
End With 
Application.ScreenUpdating = True 
End Sub 

Answer 1

添加新行后添加它。

For i = LastEvenlyDivisibleRow To 1 Step -RowIncrement 
    .Range(i & ":" & i + (NumRowsToInsert - 1)).Insert xlShiftDown 
    .Range("A" & i & ":H" & i + (NumRowsToInsert - 1)).Interior.TintAndShade = -0.249977111117893 
Next i 

注意这个特殊的TintAndShade出来作为无彩色的我...

Answer 2

插入和排它没有理想和慢速设置色彩行。更好的方法是将它们全部插入一次：

Sub InsertRowsAndSetColor() 

    Const StartRow = 1 
    Const NumRowsToInsert = 1 
    Const RowIncrement = 6 

    Dim ws As Worksheet, rg As Range, rowCount As Long, r As Long 
    Set ws = ActiveSheet 
    rowCount = ws.UsedRange.row + ws.UsedRange.Rows.count 

    ' exit if not enough rows 
    If rowCount <= StartRow + RowIncrement Then Exit Sub 

    ' collect all the rows requireing an insertion 
    Set rg = ws.Rows(StartRow + RowIncrement) 
    For r = StartRow + RowIncrement To rowCount Step RowIncrement 
    If NumRowsToInsert > 1 Then 
     Set rg = Union(rg, ws.Range(ws.Rows(r), ws.Rows(r + NumRowsToInsert - 1))) 
    Else 
     Set rg = Union(rg, ws.Rows(r)) 
    End If 
    Next 

    ' insert the rows 
    rg.Insert xlShiftDown 

    ' set the interior for the new rows within A:H 
    With Intersect(rg.offset(-NumRowsToInsert), ws.Columns("A:H")).Interior 
    .TintAndShade = -0.249977111117893 
    End With 

End Sub