单元格的内部颜色，直到最后一个单元格包含数据

Question

这是我的问题：

• 我有一个 Excel 电子表格，其中有 sheet2 的整体数据和 sheet3 到 sheet8，数据基于从 sheet2 复制的年份。
• 在每个工作表（Sheet3-8）中，每行（不包括第 1 行）中的值被添加 并对 D 列中的每一行求和。
• 在 D 列中从第 2 行到第 2 行使用内部颜色和粗体字 最后一行数据我使用了以下代码（例如 表 3)。
• 将使用 sheet2 中的命令按钮更新电子表格。
• 当我在 VB 开发人员中单独运行代码时，有时它可以工作 有时会导致运行时错误 1004。
• 当我尝试使用按钮更新电子表格时，它总是 导致错误。

{Sheet3.Range("D2", Cells(Rows.Count, "D").End(xlUp).Offset(-2, 0)).Interior.Color = RGB(255, 192, 0)} {Sheet3.Range("D2", Cells(Rows.Count, "D").End(xlUp).Offset(-2, 0)).Font.Bold=True}

完整代码如下图：

{Sub YearlyForcast2011_2012()

Sheet3.Columns("D").HorizontalAlignment = xlRight
Dim j As Integer
Dim lastrow2 As Long
Dim sumrange As Long


lastrow2 = Sheet3.Cells(Rows.Count, 1).End(xlUp).Row
For j = 2 To lastrow2

Sheet3.Cells(j, 4).Value = Sheet3.Cells(j, 5).Value + Sheet3.Cells(j, 6).Value + Sheet3.Cells(j, 7).Value + Sheet3.Cells(j, 8) + Sheet3.Cells(j, 9).Value + Sheet3.Cells(j, 10).Value + Sheet3.Cells(j, 11).Value +      Sheet3.Cells(j, 12).Value + Sheet3.Cells(j, 13).Value + Sheet3.Cells(j, 14).Value + Sheet3.Cells(j, 15).Value + Sheet3.Cells(j, 16).Value

Next j

   sumrange = Sheet3.Cells(Rows.Count, "D").End(xlUp).Row
   Sheet3.Range("D" & sumrange + 2).Formula = "=SUM(D2:D" & sumrange & ")"
   Sheet3.Range("D" & sumrange + 2).Font.Bold = True
   Sheet3.Range("D" & sumrange + 2).Font.Size = 12
   Sheet3.Range("D" & sumrange + 2).Font.Color = RGB(255, 0, 0)
   Sheet3.Range("D2", Cells(Rows.Count, "D").End(xlUp).Offset(-2, 0)).Interior.Color = RGB(255, 192, 0)
   Sheet3.Range("D2", Cells(Rows.Count, "D").End(xlUp).Offset(-2, 0)).Font.Bold=True

Sheet3.Range("c" & sumrange + 2).Value = "TOTAL 2011-2011 YEARLY FORCAST"
Sheet3.Range("c" & sumrange + 2).Font.Bold = True
Sheet3.Range("c" & sumrange + 2).Font.Size = 12
Sheet3.Range("c" & sumrange + 2).Font.Color = RGB(255, 0, 0)
Sheet3.Range("c" & sumrange + 2).HorizontalAlignment = xlRight


Application.ScreenUpdating = False
Application.CutCopyMode = False


 End Sub
}

有人可以帮我避免错误并更新电子表格，在工作表的每个 D 列中保留内部颜色和粗体字体吗？

Answer 1

试试这个：
行前

Sheet3.Range("D2", Cells(Rows.Count, "D").End(xlUp).Offset(-2, 0)).Interior.Color = RGB(255, 192, 0)
Sheet3.Range("D2", Cells(Rows.Count, "D").End(xlUp).Offset(-2, 0)).Font.Bold=True  

添加

lastrow2 = Sheet3.Cells(Rows.Count, "D").End(xlUp).Row

并将你的行改为：

Sheet3.Range("D2", Cells(lastrow2, "D")).Interior.Color = RGB(255, 192, 0)
Sheet3.Range("D2", Cells(lastrow2, "D")).Font.Bold = True

你也可以改变这个：

For j = 2 To lastrow2

Sheet3.Cells(j, 4).Value = Sheet3.Cells(j, 5).Value + Sheet3.Cells(j, 6).Value + Sheet3.Cells(j, 7).Value + Sheet3.Cells(j, 8) + Sheet3.Cells(j, 9).Value + Sheet3.Cells(j, 10).Value + Sheet3.Cells(j, 11).Value +      Sheet3.Cells(j, 12).Value + Sheet3.Cells(j, 13).Value + Sheet3.Cells(j, 14).Value + Sheet3.Cells(j, 15).Value + Sheet3.Cells(j, 16).Value

Next j  

对此：

Sheet3.Range("D2:D" & lastrow2).Formula = "=SUM(E2:T2)"  

要运行表 3-8，整个代码将如下所示（记住 j 是表的索引！必要时进行调整）：

Sub YearlyForcast2011_2012()

Dim j As Integer
Dim lastrow2 As Long
Dim sumrange As Long

For j = 3 To 8

    Sheets(j).Columns("D").HorizontalAlignment = xlRight

    lastrow2 = Sheets(j).Cells(Rows.Count, 1).End(xlUp).Row

     Sheets(j).Range("D2:D" & lastrow2).Formula = "=SUM(E2:T2)"

    sumrange = Sheets(j).Cells(Rows.Count, "D").End(xlUp).Row

     Sheets(j).Range("D" & sumrange + 2).Formula = "=SUM(D2:D" & sumrange & ")"
     Sheets(j).Range("D" & sumrange + 2).Font.Bold = True
     Sheets(j).Range("D" & sumrange + 2).Font.Size = 12
     Sheets(j).Range("D" & sumrange + 2).Font.Color = RGB(255, 0, 0)

    lastrow2 = Sheets(j).Cells(Rows.Count, "D").End(xlUp).Row

     Sheets(j).Range("D2", Cells(lastrow2, "D")).Interior.Color = RGB(255, 192, 0)
     Sheets(j).Range("D2", Cells(lastrow2, "D")).Font.Bold = True

     Sheets(j).Range("c" & sumrange + 2).Value = "TOTAL 2011-2011 YEARLY FORCAST"
     Sheets(j).Range("c" & sumrange + 2).Font.Bold = True
     Sheets(j).Range("c" & sumrange + 2).Font.Size = 12
     Sheets(j).Range("c" & sumrange + 2).Font.Color = RGB(255, 0, 0)
     Sheets(j).Range("c" & sumrange + 2).HorizontalAlignment = xlRight

Next j

Application.ScreenUpdating = False
Application.CutCopyMode = False

End Sub