差异，条件

Question

我正在比较我的表格中的日期。日期在H和I列。

H列中的日期称为S.date，我称为开始日期。

列H完全填满，而第I列则有空行。

我的病例很少，

案例1：如果开始日期是> 4周的s.date然后我按时称呼它。 例如：s.Date：17.05.2017，开始日期是20.06.2017，然后按时调用。

case2：如果开始日期是＆lt; 8周的时间，然后我称之为延迟。 case3：如果sart日期在s.date的4到8周之间，那么我称之为Remaining。

案例4：有些情况下，我的S.Date为31.03.2017，开始日期为24.02.2017，我希望它们打印为绿色。我怎样才能实现这一目标？ 谁能建议我怎么做呢？

Sub status()
Dim ws As Worksheet
Dim lrow As Long, i As Long
Dim zWeeks As Double, zcolour As Long
Dim Ztext As String
Set ws = Sheets("Result")
With ws
lrow = .Range("H" & .Rows.Count).End(xlUp).Row
For i = 5 To lrow
zWeeks = DateDiff("ww", .Range("I" & i).Value, .Range("H" & i).Value)
If .Range("E" & i).Value <> "" And .Range("F" & i).Value <> "" And .Range("I" & i).Value = "" Then
Ztext = "remaining"
zcolour = vbYellow
Cells(i, 11) = "Yellow"
ElseIf .Range("F" & i).Value = "" And .Range("I" & i).Value = "" Then
GoTo nextrow
ElseIf zWeeks < 4 Then
Ztext = "  on time"
zcolour = vbGreen
Cells(i, 11) = "Green"
ElseIf zWeeks > 8 Then
Ztext = " delayed"
zcolour = vbRed
Cells(i, 11) = "Red"
ElseIf zWeeks > 4 < 8 Then
Ztext = " remaining"
zcolour = vbYellow
Cells(i, 11) = "Yellow"
End If
With .Range("J" & i)
.Value = Ztext
.Interior.Color = zcolour
End With
nextrow:
Next i
End With
End Sub 

Answer 1

我想你想要案例......这就是你的代码应该是这样的：

Sub Status()

    Dim ws          As Worksheet
    Dim lrow        As Long
    Dim i           As Long
    Dim zWeeks      As Double
    Dim zcolour     As Long
    Dim Ztext       As String

    Set ws = Worksheets(1)

    With ws
        lrow = .Cells(.Rows.Count, "H").End(xlUp).Row

        For i = 5 To lrow
            zWeeks = DateDiff("ww", .Range("I" & i).Value, .Range("H" & i).Value)

            Select Case True

            Case .Range("E" & i).Value <> "" And _
                 .Range("F" & i).Value <> "" And _
                 .Range("I" & i).Value = ""

                Ztext = "remaining"
                zcolour = vbYellow
                Cells(i, 11) = "Yellow"
                Call ColorMe(i, ws, Ztext, zcolour)

            Case .Range("F" & i).Value = "" And .Range("I" & i).Value = ""
                'Do not write nothing here, to avoid the nasty goto

            Case zWeeks < 4
                Ztext = "  on time"
                zcolour = vbGreen
                Cells(i, 11) = "Green"
                Call ColorMe(i, ws, Ztext, zcolour)

            Case zWeeks > 8
                Ztext = " delayed"
                zcolour = vbRed
                Cells(i, 11) = "Red"
                Call ColorMe(i, ws, Ztext, zcolour)

            Case zWeeks < 8
                Ztext = " remaining"
                zcolour = vbYellow
                Cells(i, 11) = "Yellow"
                Call ColorMe(i, ws, Ztext, zcolour)
            End Select
        Next i

    End With

End Sub

Public Sub ColorMe(lng As Long, ws As Worksheet, Ztext As String, zcolour As Long)

    With ws.Range("J" & lng)
        .Value = Ztext
        .Interior.Color = zcolour
    End With

End Sub

改变了什么：

• 避免使用GoTo，因为它只应在错误捕获中使用。
• 我添加了一个模块ColorMe（），以便只为特定情况而不是2.一个颜色。
• 这就是全部，它应该有效。如果不是，我很确定你能够自己调整条件。

干杯！ ：）