Board logo

標題: [發問] 日期區間查詢(跨年月) [打印本頁]
作者: sammay    時間: 2012-1-16 08:43     標題: 日期區間查詢(跨年月)

請問各位前輩：
日期區間查詢應如何實做呢？
例如：在userform1中按下查詢按鈕，再(於userform3中)選擇100年12月到101年1月按下確定按鈕後，將結果輸出到查詢明細？
[attach]9218[/attach]
作者: GBKEE    時間: 2012-1-16 13:14

回復 1# sammay
UserForm3
  1. Dim 日期()
  2. Private Sub UserForm_Initialize()
  3.     CommandButton1.Enabled = False                            '確定鈕控制項: 不可以使用
  4.     日期 = Array(ComboBox1, ComboBox2, ComboBox3, ComboBox4)  '將年月的輸入 置入在陣列
  5.     ComboBox1.RowSource = "下拉選單!c2:c11"
  6.     ComboBox2.RowSource = "下拉選單!d2:d13"
  7.     ComboBox3.RowSource = "下拉選單!c2:c11"
  8.     ComboBox4.RowSource = "下拉選單!d2:d13"
  9. End Sub
  10. Private Sub CommandButton1_Click()
  11.     Dim Data As Range, Rng As Range, Day1 As Date, Day2 As Date, Msg As String, E As Range
  12.     Set Data = Sheets("總表").Range("A3").CurrentRegion
  13.     'Range("A3").CurrentRegion :   總表的資料 A2:D2 ,E欄 請不要有資料輸入
  14.     If Data.Rows.Count = 1 Then         '只有欄位
  15.         MsgBox "總表:  沒有資料 !!!"
  16.         Unload Me
  17.         Exit Sub
  18.     End If
  19.     Day1 = DateSerial(日期(0), 日期(1), 1)                   '轉入日期
  20.     Day2 = DateSerial(日期(2), 日期(3), 1)
  21.     For Each E In Data.Columns(1).Offset(1).Cells             '[A4]->
  22.         If DateSerial(E, E.Cells(1, 2), 1) >= Day1 And DateSerial(E, E.Cells(1, 2), 1) <= Day2 Then
  23.             If Rng Is Nothing Then                     '初次
  24.                 Set Rng = E.Resize(1, 4)
  25.             Else                                        '第二次以後
  26.                 Set Rng = Union(Rng, E.Resize(1, 4))
  27.             End If
  28.         End If
  29.     Next
  30.     Msg = 日期(0) & "/" & 日期(1) & " - " & 日期(2) & "/" & 日期(3)
  31.     If Rng Is Nothing Then
  32.         MsgBox Msg & "找不到  資料"
  33.     Else
  34.         Rng.Copy Sheets("查詢明細").Cells(Rows.Count, 1).End(xlUp).Offset(1)
  35.         'Rng 複製到 "查詢明細"A欄 最後一筆有資料的下一格  Offset(1)
  36.         MsgBox Msg & " 找到  " & Rng.Count / Data.Columns.Count & " 筆資料"
  37.     End If
  38.         Unload Me
  39. End Sub
  40. Private Sub ComboBox1_Change()
  41.     Check_日期
  42. End Sub
  43. Private Sub ComboBox2_Change()
  44.      Check_日期
  45. End Sub
  46. Private Sub ComboBox3_Change()
  47.      Check_日期
  48. End Sub
  49. Private Sub ComboBox4_Change()
  50.     Check_日期
  51. End Sub
  52. Private Sub Check_日期()      '判別 年月輸入
  53.     Dim Msg As Boolean, E As Variant
  54.     For Each E In 日期                          '依序處裡: 年月的輸入
  55.         If Not IsNumeric(E) Then                '不是數字
  56.             CommandButton1.Enabled = False      '確定鈕控制項: 不可以使用
  57.             Msg = True                          'Msg設定為 True
  58.             Exit For
  59.         End If
  60.     Next
  61.     If Msg = False Then                         '日期皆為數字
  62.         If DateSerial(日期(0), 日期(1), 1) <= DateSerial(日期(2), 日期(3), 1) Then
  63.           'DateSerial(年,月, 1)
  64.             CommandButton1.Enabled = True           '確定鈕控制項: 可以使用
  65.         Else
  66.             CommandButton1.Enabled = False          '確定鈕控制項: 不可以使用
  67.         End If
  68.     End If
  69. End Sub
複製代碼
作者: Hsieh    時間: 2012-1-16 18:30

回復 1# sammay
  1. Private Sub CommandButton1_Click()
  2. Dim Ar()
  3. s = CDate(Val(ComboBox1) + 1911 & "/" & ComboBox2 & "/1"): s1 = CDate(Val(ComboBox3) + 1911 & "/" & ComboBox4 & "/1")
  4. s1 = DateAdd("m", 1, s1) - 1
  5. With Sheet1
  6. For Each a In .Range(.[A4], .[A4].End(xlDown))
  7. d = DateSerial(a + 1911, a.Offset(, 1), a.Offset(, 2))
  8. If s <= d And s1 >= d Then
  9. ReDim Preserve Ar(i)
  10. Ar(i) = a.Resize(, 4).Value
  11. i = i + 1
  12. End If
  13. Next
  14. End With
  15. With Sheet2
  16. .Select
  17. .Range(.[A4:D4], .[A4:D4].End(xlDown)) = ""
  18. If i > 0 Then
  19. .[A4].Resize(i, 4) = Application.Transpose(Application.Transpose(Ar))
  20. Else
  21. MsgBox "無符合資料"
  22. End If
  23. End With
  24. Unload Me
  25. End Sub

  27. Private Sub UserForm_Initialize()
  28. Set d = CreateObject("Scripting.Dictionary")
  29. With Sheet1
  30. For Each a In .Range(.[A4], .[A4].End(xlDown))
  31. d(a.Value) = ""
  32. Next
  33. End With
  34. ComboBox1.List = d.keys
  35. ComboBox2.List = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
  36. ComboBox3.List = d.keys
  37. ComboBox4.List = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
  38. End Sub
複製代碼
作者: sammay    時間: 2012-1-17 08:35

回復 2# GBKEE
感謝G大回覆，已經可以執行，其中程式碼
Range("A3").CurrentRegion :   總表的資料 A2:D2 ,E欄 請不要有資料輸入
不太明白？
作者: sammay    時間: 2012-1-17 08:37

本帖最後由 sammay 於 2012-1-17 08:44 編輯

回復 3# Hsieh
感謝H大回覆，程式碼
s = CDate(Val(ComboBox1) + 1911 & "/" & ComboBox2 & "/1"): s1 = CDate(Val(ComboBox3) + 1911 & "/" & ComboBox4 & "/1")
其中"/1"為何意呢？還有＋1911用意呢？
作者: GBKEE    時間: 2012-1-17 09:17

本帖最後由 GBKEE 於 2012-1-17 09:18 編輯

回復 4# sammay
CurrentRegion 屬性   該物件代表目前的區域。目前區域是指以任意空白列及空白欄的組合為邊界的範圍。
  1. Sub Ex()
  2.     With ActiveCell.CurrentRegion.Borders
  3.         .LineStyle = 1
  4.         .ColorIndex = 7
  5.     End With
  6. End Sub
複製代碼
如圖 的範圍中選取單一有資料的杵存格 執行Ex巨集

[attach]9238[/attach]

其中"/1"為何意呢？還有＋1911用意呢？
/1 :            使其日期為每月的1日
＋1911 :  因你的年度是民國, +1911成為西元年度
作者: sammay    時間: 2012-1-19 08:23

回復 6# GBKEE
感謝G大回覆，瞭解。
敬祝 各位先進前輩們 新年快樂 萬事如意 心想事成
作者: JOYARK    時間: 2012-4-26 16:29

謝謝提供學習非常實用
作者: afu9240    時間: 2018-2-27 16:21

回復 6# GBKEE

G大 您好
  如果日期格式為我附件這種類型要如何取日期範圍出來,再貼在新的工作表呢!!![attach]28401[/attach][attach]28401[/attach]
作者: Hsieh    時間: 2018-2-27 17:07

本帖最後由 Hsieh 於 2018-2-27 17:08 編輯

回復 9# afu9240
  1. Private Sub CommandButton4_Click() '查詢按鈕
  2. Set d = CreateObject("Scripting.Dictionary")
  3. s = DateValue(ComboBox2 & "/" & ComboBox3 & "/1")
  4. x = DateAdd("m", 1, DateValue(ComboBox5 & "/" & ComboBox4 & "/1")) - 1
  5. With 工作表1
  6. For Each a In .Range(.[A2], .[A2].End(xlDown))
  7.    If a >= s And a <= x Then
  8.       d(a.Offset(, 2).Value) = d(a.Offset(, 2).Value) + a.Offset(, 1)
  9.    End If
  10. Next
  11. End With
  12. With Sheets("總表")
  13.   For Each a In .[C3:C13]
  14.      a.Offset(, 1) = d(a.Value)
  15.   Next
  16. End With
  17. End Sub
複製代碼
[attach]28402[/attach]
作者: afu9240    時間: 2018-3-1 16:31

回復 10# Hsieh

CreateObject("Scripting.Dictionary") '不懂其意思 可以大概說明解惑嗎??感恩不盡
作者: Hsieh    時間: 2018-3-2 09:37

回復 11# afu9240
這是創建字典物件的意思
就是將資料以關鍵字存放內容
基本語法
object.add key,item
object為字典物件
add方法增加項目
key為關鍵索引，以add方法加入項目時，若索引值重複則會產生錯誤
item為對應key索引值之內容
所以用事由做為索引值，對應值為加總金額先存在字典物件中
再由總表事由欄位對應取出字典內容填入
作者: afu9240    時間: 2018-3-2 14:19

回復 12# Hsieh


    H大 您好
   
      附件為何帶入您給的code 無法執行???再請教H大  謝謝[attach]28406[/attach]
作者: Hsieh    時間: 2018-3-2 14:29

本帖最後由 Hsieh 於 2018-3-2 14:49 編輯

回復 13# afu9240
你工作表1的欄位改變
Private Sub CommandButton4_Click() '匯入計算按鈕
Set d = CreateObject("Scripting.Dictionary")
s = DateValue(ComboBox2 & "/" & ComboBox3 & "/1")
x = DateAdd("m", 1, DateValue(ComboBox5 & "/" & ComboBox4 & "/1")) - 1
With 工作表1
For Each a In .Range(.[A2], .[A2].End(xlDown))
   If a >= s And a <= x Then
      d(a.Offset(, 1).Value) = d(a.Offset(, 2).Value) + a.Offset(, 2)
   End If
Next
End With
With Sheets("總表")
  For Each a In .[C3:C13]
     a.Offset(, 1) = d(a.Value)
  Next
End With
End Sub
作者: afu9240    時間: 2018-3-8 09:42

回復 14# Hsieh

H大,請教一下
     為何我資料瀏覽_listbox選擇單號瀏覽時無法顯示內容......可以協助嗎???~謝謝[attach]28417[/attach][attach]28418[/attach]
作者: Hsieh    時間: 2018-3-9 15:28

回復 15# afu9240

我新增一個表單試作流程，你參考看看

    [attach]28427[/attach]



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