Question

我试图循环这个宏，它根据年份改变行的颜色，通过当前工作簿中的所有工作表，并且似乎无法弄清楚如何这样做。我试图将其他问题和答案拼凑在一起但无济于事。任何帮助，将不胜感激。这是代码：

Sub ExpirationYeartoColors()
Dim num As Integer, lr As Long, r As Long
lr = Cells(Rows.Count, "A").End(xlUp).Row

ActiveSheet.Select

For r = 2 To lr

Select Case Range("A" & r).Value
    Case Is = "2015"
    Range("A" & r).Interior.Color = RGB(181, 189, 0)
    Case Is = "2016"
    Range("A" & r).Interior.Color = RGB(0, 56, 101)
    Case Is = "2017"
    Range("A" & r).Interior.Color = RGB(0, 147, 178)
    Case Is = "2018"
    Range("A" & r).Interior.Color = RGB(155, 211, 221)
    Case Is = "2019"
    Range("A" & r).Interior.Color = RGB(254, 222, 199)
    Case Is = "2020"
    Range("A" & r).Interior.Color = RGB(238, 242, 210)
    Case "2020" To "2080"
    Range("A" & r).Interior.Color = RGB(238, 242, 210)
    Case Is = "Unknown"
    Range("A" & r).Interior.Color = RGB(197, 200, 203)
    Case Is = "Available"
    Range("A" & r).Interior.Color = RGB(247, 150, 91)
    Case Is = "CommonArea"
    Range("A" & r).Interior.Color = RGB(230, 230, 230)
    Case Else
    Range("A" & r).Interior.Color = RGB(255, 255, 255)
End Select
Next r

On Error GoTo ErrorHandler
   ' Insert code that might generate an error here
   Exit Sub
ErrorHandler:
   ' Insert code to handle the error here
   Resume Next

End Sub

Answer 1

我已经计算了工作簿上可用的工作表数量并存储到变量中。然后使用for循环遍历整个工作簿，直到最后一个工作表。

被阻止的代码是代码中的修改部分。

此外，我看到2020 - 2080的情况，格式颜色相同。

t = ActiveWorkbook.Worksheets.Count
i = 0
For i = 1 To t
Worksheets("sheet" & i).Activate

lr = Cells(Rows.Count, "A").End(xlUp).Row

ActiveSheet.Select

For r = 2 To lr

Select Case Range("A" & r).Value
    Case Is = "2015"
    Range("A" & r).Interior.Color = RGB(181, 189, 0)
    Case Is = "2016"
    Range("A" & r).Interior.Color = RGB(0, 56, 101)
    Case Is = "2017"
    Range("A" & r).Interior.Color = RGB(0, 147, 178)
    Case Is = "2018"
    Range("A" & r).Interior.Color = RGB(155, 211, 221)
    Case Is = "2019"
    Range("A" & r).Interior.Color = RGB(254, 222, 199)
    Case Is = "2020"
    Range("A" & r).Interior.Color = RGB(238, 242, 210)
    Case "2021" To "2080"
    Range("A" & r).Interior.Color = RGB(238, 242, 210)
    Case Is = "Unknown"
    Range("A" & r).Interior.Color = RGB(197, 200, 203)
    Case Is = "Available"
    Range("A" & r).Interior.Color = RGB(247, 150, 91)
    Case Is = "CommonArea"
    Range("A" & r).Interior.Color = RGB(230, 230, 230)
    Case Else
    Range("A" & r).Interior.Color = RGB(255, 255, 255)
End Select
Next r

Next i

On Error GoTo ErrorHandler
   ' Insert code that might generate an error here
   Exit Sub
ErrorHandler:
   ' Insert code to handle the error here
   Resume Next

End Sub

{{1}}

这将遍历所有工作表并进行格式化。代码经过测试，运行正常

Answer 2

Here是你的答案......你需要一个变量来计算工作表，然后将你的循环放在另一个“for”中，以便遍历所有工作表。

或者如果你想要，你可能会用一段时间......

Answer 3

有几种方法可以遍历工作簿中的工作表。我更喜欢工作表索引方法，它根据工作表队列中的位置简单地识别工作表。

Sub ExpirationYeartoColors()
    Dim w As Long, lr As Long, r As Long, vVAL As Variant

    For w = 1 To Worksheets.Count
        With Worksheets(w)
            lr = .Cells(Rows.Count, "A").End(xlUp).Row
            For r = 2 To lr
                vVAL = .Range("A" & r)
                If IsNumeric(vVAL) Then
                    'treat numbers as numbers!!!
                    vVAL = Int(vVAL)   'maybe vVAL = Year(vVAL) ?
                    Select Case vVAL
                        Case 2015
                            .Range("A" & r).Interior.Color = RGB(181, 189, 0)
                        Case 2016
                            .Range("A" & r).Interior.Color = RGB(0, 56, 101)
                        Case 2017
                            .Range("A" & r).Interior.Color = RGB(0, 147, 178)
                        Case 2018
                            .Range("A" & r).Interior.Color = RGB(155, 211, 221)
                        Case 2019
                            .Range("A" & r).Interior.Color = RGB(254, 222, 199)
                        Case 2020
                            .Range("A" & r).Interior.Color = RGB(238, 242, 210)
                        Case 2021 To 2080
                            .Range("A" & r).Interior.Color = RGB(238, 242, 210)
                        Case Else
                            .Range("A" & r).Interior.Pattern = xlNone
                    End Select
                Else
                    Select Case vVAL
                        Case Is = "Unknown"
                            .Range("A" & r).Interior.Color = RGB(197, 200, 203)
                        Case Is = "Available"
                            .Range("A" & r).Interior.Color = RGB(247, 150, 91)
                        Case Is = "CommonArea"
                            .Range("A" & r).Interior.Color = RGB(230, 230, 230)
                        Case Else
                            .Range("A" & r).Interior.Pattern = xlNone
                    End Select
                End If
            Next r
        End With
    Next w


On Error GoTo ErrorHandler
   ' Insert code that might generate an error here
   Exit Sub
ErrorHandler:
   ' Insert code to handle the error here
   Resume Next

End Sub

有许多未解答的问题;特别是关于数据的性质。但是，您应该将数字视为数字，特别是如果您想在Case "2020" To "2080"之类的地方使用它们。我试图分别确定值的性质和处理的文本和数字。这个编译，但没有样本数据或提出的评论的答案我不能保证其有效性。

将 .pattern 设置为xlNone会删除内部填充，而不是将其绘制为白色。

有关远离依赖选择和激活以实现目标的更多方法，请参阅How to avoid using Select in Excel VBA macros。

Answer 4

使用条件格式（CF）还有另一种方法。

优势在于，一旦设置了CF，单元格的格式化将响应任何已更改的值。

您可以使用VBA代码通过循环工作簿中的所有工作表并运行VBA代码来添加CF，从而将CF添加到所有工作表。或者您可以手动添加它，如下所示。

我知道你可能因其他原因需要编写VBA代码，如果你这样做，其他答案都很好，但我怀疑这可能适合你。

Select all rows on a sheet (or as many as you need).

Ribbon>HOME>Conditional formatting
Choose: "Use a Formula to determine which cells to format"

Enter this formula  "=AND($A1=2010,$A1>0)"
(it assume your data value is in column A
 it assumes the first row you selected was row 1)

Enter the formatting you want for the whole row when year in column A=2010

每年添加一个条件格式。

我建议您录制一个宏，然后根据需要进行更改，以便每年为每张纸添加CF.

有时简单是最好的。

哈维

循环宏遍历所有工作表

4 个答案: