通过所有工作表循环macros

我试图通过当前工作簿中的所有工作表来循环这个macros,它改变了一年的行的颜色,似乎无法弄清楚如何做到这一点。 我试图从其他问题和答案一些东西一起,无济于事。 任何帮助,将不胜感激。 这里是代码:

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 

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

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

我也看到2020 – 2080的情况,格式颜色是一样的。

 Sub ExpirationYeartoColors() Dim num As Integer, lr As Long, r As Long 
 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 

这将遍历所有的表格,并进行格式化。 代码已经过testing,工作正常

这是你的答案…你需要一个variables来计算表,然后把你的循环内的另一个“for”通过所有表。

或者你可以用一段时间,如果你想..

循环工作簿中的工作表有几种方法。 我更喜欢工作表索引方法,它根据工作表队列中的位置简单地标识工作表。

 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将删除内部填充,而不是将其涂成白色。

请参阅如何避免使用Excel中的selectVBAmacros来获取更多的方法来摆脱依靠select和activate来实现您的目标。

有一种使用条件格式(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 

每年添加一个条件格式。

我build议你录制一个macros,并根据需要改变它,以便每一年为每张纸添加CF。

有时候简单是最好的。

哈维