Question

我正在尝试编写一个循环遍历每个表中每一行的程序（每张表一个表），以便对其进行颜色编码，类似于条件格式。这不会移动到下一张纸上，因此它只对我打开的纸张进行颜色编码。我希望它能自动移动下一个。任何输入都表示赞赏。

Dim ccShipDate As Variant
Dim ccRow As Integer
Dim wsht As Worksheet

ccRow = 2
ccShipDate = Cells(ccRow, 6)

For Each wsht In Worksheets
    If wsht.Name = "ManualReview" Or wsht.Name = "Filter" Or wsht.Name = "MRF" Or wsht.Name = "ModStd" Then
         With Worksheets(wsht.Name)

                ' loops through "Actual Ship Date" column until empty
                ' past or today = red
                ' one day away = yellow
                ' more than one day = green
                Do Until IsEmpty(ccShipDate)
                    If DateDiff("d", Date, ccShipDate) <= 0 Then
                        Cells(ccRow, 3).Interior.ColorIndex = 3

                     ElseIf DateDiff("d", Date, ccShipDate) = 1 Then
                        Cells(ccRow, 3).Interior.ColorIndex = 6

                        ElseIf DateDiff("d", Date, ccShipDate) > 1 Then
                            Cells(ccRow, 3).Interior.ColorIndex = 4


                    End If
                    ccRow = ccRow + 1
                    ccShipDate = Cells(ccRow, 6).Value

                Loop
         End With
    End If
Next wsht

End Sub

Answer 1

为您提供Scott Craner评论的完整答案

Dim ccShipDate As Variant
Dim ccRow As Integer
Dim wsht As Worksheet

ccRow = 2
ccShipDate = Cells(ccRow, 6)

For Each wsht In Worksheets
    If wsht.Name = "ManualReview" Or wsht.Name = "Filter" Or wsht.Name = "MRF" Or wsht.Name = "ModStd" Then
         With Worksheets(wsht.Name)
            Do Until IsEmpty(ccShipDate)
                If DateDiff("d", Date, ccShipDate) <= 0 Then
                    .Cells(ccRow, 3).Interior.ColorIndex = 3

                 ElseIf DateDiff("d", Date, ccShipDate) = 1 Then
                    .Cells(ccRow, 3).Interior.ColorIndex = 6

                 ElseIf DateDiff("d", Date, ccShipDate) > 1 Then
                     .Cells(ccRow, 3).Interior.ColorIndex = 4
                 End If
                     ccRow = ccRow + 1
                     ccShipDate = .Cells(ccRow, 6).Value
            Loop
         End With
    End If
Next wsht

End Sub

我可能还建议将If Then语句更改为...

If InStr(1, wsht.Name, "Manual Review") Or InStr(1, wsht.Name, "Filter") Or InStr(1, wsht.Name, "MRF") Or InStr(1, wsht.Name, "ModStd")

这样它会检查字符串是否在工作表名称中

在excel中循环使用多个工作表

1 个答案: