返回列表 上一主題 發帖

[發問] 日期區間查詢(跨年月)

回復 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

  26. Private Sub UserForm_Initialize()
  27. Set d = CreateObject("Scripting.Dictionary")
  28. With Sheet1
  29. For Each a In .Range(.[A4], .[A4].End(xlDown))
  30. d(a.Value) = ""
  31. Next
  32. End With
  33. ComboBox1.List = d.keys
  34. ComboBox2.List = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
  35. ComboBox3.List = d.keys
  36. ComboBox4.List = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12)
  37. End Sub
複製代碼
學海無涯_不恥下問

TOP

本帖最後由 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
複製代碼
複本 如何將資料匯入總表.zip (33.03 KB)
學海無涯_不恥下問

TOP

回復 11# afu9240
這是創建字典物件的意思
就是將資料以關鍵字存放內容
基本語法
object.add key,item
object為字典物件
add方法增加項目
key為關鍵索引,以add方法加入項目時,若索引值重複則會產生錯誤
item為對應key索引值之內容
所以用事由做為索引值,對應值為加總金額先存在字典物件中
再由總表事由欄位對應取出字典內容填入
學海無涯_不恥下問

TOP

本帖最後由 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
學海無涯_不恥下問

TOP

回復 15# afu9240

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

    各項付款.zip (47.28 KB)
學海無涯_不恥下問

TOP

        靜思自在 : 站在半路,比走到目標更辛苦。
返回列表 上一主題