Question

我有一个工作宏，每隔第6行添加一个空行，效果很好！我有一个问题，这很简单，但它不起作用：S 我希望为这些新行着色：.TintAndShade = -0.249977111117893，并且只有A到H列之间的单元格。

我不知道在此代码中将其添加到何处。有人能帮助我吗？

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

如何在宏中着色行

2 个答案: