標題: [發問] 依日期取資料 [打印本頁]

---

作者: qaqa3296    時間: 2020-9-12 20:32     標題: 依日期取資料

本帖最後由 qaqa3296 於 2020-9-12 20:42 編輯

依分頁1的E2日期去判斷分頁目標的生效與失效日期
[attach]32535[/attach]

條件
按鈕放到分頁1
生效與失效日期為空白時，該行要列出
生效日期與失效日期都相同時，已失效為準，該行不列出

符合條件的資料列到成果，以2020/09/12為例
[attach]32536[/attach]

日期比對要如何寫沒有頭緒，爬文看CDdate、dateVaule、#()#，看不懂如何運用，希望各位大大幫忙

---

作者: 軒云熊    時間: 2020-9-13 00:31

回復 1# qaqa3296
有空幫我 測試一下看看是不是 你要的
生效日期與失效日期都相同時，已失效為準，該行不列出    這我不太明白   你先試試看是不是這樣

javascript:;

---

作者: qaqa3296    時間: 2020-9-13 11:26

回復 2# 軒云熊

感謝軒云熊的程式，功能正確

然後看到熟悉的字串拆開格式，才發現我某一天的日期格式打錯了!

讓你多寫分割文字

詢問一下
U = True: K = 1
For i = 1 To UBound(Arr)
    If U = True Then
        For F = 1 To UBound(Arr, 2)
            Brr(1, F) = Arr(1, F)
        Next F
    U = False
    End If
作用是什麼?

---

作者: 軒云熊    時間: 2020-9-13 12:43

本帖最後由 軒云熊 於 2020-9-13 12:47 編輯

回復 3# qaqa3296
那只是列出 標題而已沒有甚麼作用  ...XD    謝謝你幫我測試

---

作者: 軒云熊    時間: 2020-9-13 14:08

回復 3# qaqa3296
這是 加了刪除重複 應該會快一點點 順便把 Select Case 改成 if  感覺不太適用 >"<


javascript:;

---

作者: 軒云熊    時間: 2020-9-13 15:04

回復 3# qaqa3296
抱歉 迴圈沒有刪除到... 再傳一次 >"<


javascript:;

---

作者: qaqa3296    時間: 2020-9-13 21:20

本帖最後由 qaqa3296 於 2020-9-13 21:32 編輯

回復 6# 軒云熊

抱歉我前面沒有測試出來，邏輯是有問題的

但我可以自行修改

附上測試結果

有在目標打上備註

---

作者: 軒云熊    時間: 2020-9-13 22:44

回復 7# qaqa3296
好的　謝謝你幫我測試　我也改了一下有空幫我看一下是不是這樣　想知道哪裡有問題　:) 　　　



    javascript:;

---

作者: 准提部林    時間: 2020-9-14 09:48

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

---

作者: qaqa3296    時間: 2020-9-14 20:22

本帖最後由 qaqa3296 於 2020-9-14 20:30 編輯

回復 9# 准提部林

我取得的資料，全部的格式只有YYYY/MM/DD/，模擬檔打錯了抱歉。

這是一個ERP的功能。
資料呈現是每個表料件都有生效與失效的日期，輸入日期就能知道當時用什麼料

我想把它當作練習並學習寫程式，但腦袋卡住了
不知如何才能讓日期格式去比大小，花了一兩個星期...想不出來試也試不出來

就是單純的比日期大小取得對應料件資訊。
但是要符合時間邏輯，第一次建檔完全沒有時間全部料有用到(全列出)
之後改版取消料件，就會給失效日，新增料會給生效日(開始有日期差異)
生效日到，但無法量產製造則生效與失效是同天，所以實際也沒有用到那個料件(不列出)

7樓的那個檔可以看出我想要的邏輯。




回復軒云熊
這次邏輯對了，感謝你的程式讓我學習

---

作者: 軒云熊    時間: 2020-9-14 20:59

本帖最後由 軒云熊 於 2020-9-14 21:03 編輯

回復 10# qaqa3296
別這麼說  我也是新手 我們互相學習 互相幫助   我想無法解決的問題  在提出來大大們也會有答案

---

作者: 准提部林    時間: 2020-9-15 11:22

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  生效日期>指定日


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

---

作者: jcchiang    時間: 2020-9-15 12:13

回復 7# qaqa3296

試試看
Sub ex()
Dim c As Range
Dim a As Object
Dim 日期$
日期 = Sheets("Form").[E2]
Sheets("成果").Range([a2], [a2].End(4).Offset(, 5)).ClearContents
Set c = Nothing
With Sheets("目標")
For Each a In .Range(.[a2], .[a65535].End(3))
   If (a.Offset(, 5) = "" Or a.Offset(, 5) > 日期) And (a.Offset(, 4) = "" Or a.Offset(, 4) <= 日期) Then
      If c Is Nothing Then
         Set c = a.Resize(, 6)
      Else
         Set c = Union(c, a.Resize(, 6))
      End If
   End If
Next
End With
c.Copy Sheets("成果").[a2]
Set c = Nothing
End Sub

---

作者: qaqa3296    時間: 2020-9-15 20:19

回復 13# jcchiang

感謝准提部林、jcchiang

提供其他寫法供大家學習

程式效果都正確

想問一下jcchiang大大

你的程式我看不出來有宣告或其他日期函數?

那為何可以正確判斷日期呢?

還是藏在哪我沒有注意到?

---

作者: 軒云熊    時間: 2020-9-15 21:03

本帖最後由 軒云熊 於 2020-9-15 21:07 編輯

看起來好像是全都依據物件或範圍本身的格式

---

作者: 軒云熊    時間: 2020-9-15 21:20

本帖最後由 軒云熊 於 2020-9-15 21:22 編輯

准大大 還有 jcchiang大大 的 思考邏輯更整密   
可以覆蓋使用原來的陣列空間 還有略過的方式做判斷
    學習中

---

作者: jcchiang    時間: 2020-9-16 07:56

本帖最後由 jcchiang 於 2020-9-16 07:58 編輯

回復 14# qaqa3296


    我只是依據你的檔案內容去寫,並沒有去判斷可能的日期格式問題

---

作者: 准提部林    時間: 2020-9-16 09:55

如果不判斷日期格式:
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

---

作者: 准提部林    時間: 2020-9-16 11:54

如果資料不多, 直接用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

---

歡迎光臨 麻辣家族討論版版 (http://forum.twbts.com/)