返回列表 上一主題 發帖

[發問] 依日期取資料

日期格式有多種,
數值/文字格式+mm/dd/yyyy ???
更主要是看不懂比較規則?? 比大比小???

TOP

Sub TEST_A1()
Dim Arr, T$(2), D(2), i&, j%, N&
[成果!A2:D2000].ClearContents
D(0) = [Form!E2]
If IsDate(D(0)) = False Then Exit Sub
Arr = Range([目標!F1], [目標!A65536].End(xlUp))
For i = 2 To UBound(Arr)
    If Arr(i, 1) = "" Then GoTo i01 '[品號]空白, 略過
    D(1) = Arr(i, 5) '[生效日期]
    D(2) = Arr(i, 6) '[失效日期]
    If IsDate(D(1)) Then If CDate(D(1)) > D(0) Then GoTo i01 '[生效日期]有日期, 且>指定日, 略過
    If IsDate(D(2)) Then If CDate(D(2)) <= D(0) Then GoTo i01 '[失效日期]有日期, 且<=指定日, 略過
    N = N + 1
    For j = 1 To 4: Arr(N + 1, j) = Arr(i, j): Next j
i01: Next i
If N > 0 Then [成果!A1].Resize(N + 1, 4) = Arr
End Sub

兩個日期相同, 必包含在那兩個if條件中, 不必另行判斷:
例如:指定日2020/9/8
2020/9/7  2020/9/7 失效日期<=指定日
2020/9/12  2020/9/12  生效日期>指定日


'================================

TOP

如果不判斷日期格式:
Sub TEST_A2()
Dim Arr, D, i&, j%, N&
[成果!A2:D2000].ClearContents
D = [Form!E2]: If D = "" Then Exit Sub
Arr = Range([目標!F1], [目標!A65536].End(xlUp))
For i = 2 To UBound(Arr)
    If Arr(i, 5) <> "" And Arr(i, 5) > D Then GoTo i01
    If Arr(i, 6) <> "" And Arr(i, 6) <= D Then GoTo i01
    N = N + 1
    For j = 1 To 4: Arr(N + 1, j) = Arr(i, j): Next j
i01: Next i
If N > 0 Then [成果!A1].Resize(N + 1, 4) = Arr
End Sub

TOP

如果資料不多, 直接用range即可
Sub TEST_A3()
Dim xR As Range, D
[成果!A2:D2000].ClearContents
D = [Form!E2]: If D = "" Then Exit Sub
Application.ScreenUpdating = False
For Each xR In Range([目標!A2], [目標!A65536].End(xlUp))
    If (xR(1, 5) > D) + (xR(1, 6) <> "") * (xR(1, 6) <= D) Then GoTo 101
    xR.Resize(1, 4).Copy [成果!A65536].End(xlUp)(2)
101: Next
End Sub

TOP

        靜思自在 : 【是否發揮了良能?】人間壽命因為短暫,才更顯得珍貴。難得來一趟人間,應問是否為人間發揮了自己的良能,而不要一味求長壽。
返回列表 上一主題