[發問] 如何用INPUTBOX輸入收單日期,跑出每個處方日期的數量加總,並以MSGBOX顯示

akimunekyo

請問各位前輩,我想用INPUTBOX輸入收單日期,跑出每個處方日期的數量加總,並以MSGBOX顯示
該如何去寫程式呢?
目前有想到用自動篩選和樞紐的方式,只是不知道要如何去寫
懇請前輩指導
謝謝

處方日期        入帳日期        數量        收單日期
1000103        1000103        14        100/1/4
1000117        1000117        14        100/1/18
1000131        1000131        1        100/2/1
1000131        1000131        14        100/2/1
1000201        1000201        1        100/2/7
1000207        1000207        6        100/2/8
1000207        1000207        2        100/2/8
1000214        1000214        14        100/2/15
1000228        1000228        14        100/3/1
1000314        1000314        14        100/3/15
1000328        1000328        14        100/3/29
1000411        1000411        14        100/4/14
1000425        1000425        14        100/4/26
1000502        1000502        7        100/5/3
1000509        1000509        14        100/5/10
1000511        1000511        1        100/5/12
1000512        1000512        1        100/5/16
1000513        1000513        1        100/5/16
1000513        1000513        2        100/5/16
1000514        1000514        2        100/5/16
1000515        1000515        2        100/5/16
1000516        1000516        2        100/5/17
1000517        1000517        2        100/5/18
1000518        1000518        2        100/5/19
1000519        1000519        2        100/5/20
1000520        1000520        2        100/5/23
1000521        1000521        2        100/5/23
1000522        1000522        2        100/5/23
1000522        1000522        2        100/5/23

luhpro

樞紐的方式我不會, 所以就試著用比較普通的方式來達成 :
Sub nn()
  Dim sStr$, sDate$
  Dim iRow%, iI%
  Dim vDate
  Dim oD As Object

  Set oD = CreateObject("Scripting.Dictionary")
  iRow = [A65535].End(xlUp).Row
  For iI = 2 To iRow
    oD(CStr(Cells(iI, 1))) = oD(CStr(Cells(iI, 1))) + Cells(iI, 3)
  Next iI
  vDate = InputBox("請輸入要查詢的收單日期 : ", "輸入收單日期")
  For iI = 2 To iRow
    If Trim(CStr(Cells(iI, 4))) = Trim(CStr(vDate)) Then
      If sDate <> CStr(Cells(iI, 1)) Then
        sStr = sStr + Chr(10) + CStr(Cells(iI, 1)) + " : " + CStr(oD(CStr(Cells(iI, 1))))
        sDate = CStr(Cells(iI, 1))
      End If
    End If
  Next iI
  MsgBox "收單日期 : " + vDate + " 的數量" + sStr
End Sub

Hsieh

1. Sub ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. Set d1 = CreateObject("Scripting.Dictionary")
   
4. 
   
5. myday = CDate(InputBox("輸入日期", , Date))
   
6. For Each a In Range([D2], [D65536].End(xlUp))
   
7.   If a = myday Then d(a.Offset(, -3) & "") = d(a.Offset(, -3) & "") + a.Offset(, -1)
   
8. Next
   
9. For Each ky In d.keys
   
10.    d1(ky & ":" & d(ky)) = ""
    
11. Next
    
12. MsgBox Join(d1.keys, Chr(10))
    
13. End Sub

複製代碼

GBKEE

回復 2# luhpro
樓主希望 INPUTBOX輸入收單日期,跑出每個處方日期的數量加總
  For iI = 2 To iRow
    oD(CStr(Cells(iI, 1))) = oD(CStr(Cells(iI, 1))) + Val(Cells(iI, 3))
  Next iI
這段程式碼是每一處方日期的數量加總

akimunekyo

感謝各位前輩的解答
小弟會再下功夫去研究
謝謝

luhpro

回復 4# GBKEE
是啊.
因為他首篇文章中所提供的例子裡面所有有重複出現的情形中,
收單日期與處方日期都是完全相對應(亦即沒有相異情形出現),
所以我在程式中是以此作為前提的,(我事前對此點有做過確認)
當然若樓主執行後發現數字有問題就會再提出來,
屆時程式也會做適度的調整.

因為我發現若考慮的情形越多相對的程式也就會越複雜,
但往往有些情形其實並不會發生,
故而實作上也就可以將其忽略簡化.
謝謝你有注意到此點並提出討論.

akimunekyo

回復 3# Hsieh

• Sub ex()
  
• Set d = CreateObject("Scripting.Dictionary")
  
• Set d1 = CreateObject("Scripting.Dictionary")
  
  
• myday = CDate(InputBox("輸入日期", , Date))
  
• For Each a In Range([D2], [D65536].End(xlUp))
  
•   If a = myday Then d(a.Offset(, -3) & "") = d(a.Offset(, -3) & "") + a.Offset(, -1)
  
• Next
  
• For Each ky In d.keys
  
•    d1(ky & ":" & d(ky)) = ""
  
• Next
  
• MsgBox Join(d1.keys, Chr(10))
  
• End Sub
  

感謝前輩的解答,問題已經解決
另外問一下CreateObject("Scripting.Dictionary")是要做什麼的?
謝謝

Hsieh

回復 7# akimunekyo


    http://forum.twbts.com/thread-20-1-1.html

akimunekyo

• 回復 2# luhpro
  
  
  
•     Sub nn()
  
•   Dim sStr$, sDate$
  
•   Dim iRow%, iI%
  
•   Dim vDate
  
•   Dim oD As Object
  
  
•   Set oD = CreateObject("Scripting.Dictionary")
  
•   iRow = [A65535].End(xlUp).Row
  
•   For iI = 2 To iRow
  
•     oD(CStr(Cells(iI, 1))) = oD(CStr(Cells(iI, 1))) + Cells(iI, 3)
  
•   Next iI
  
•   vDate = InputBox("請輸入要查詢的收單日期 : ", "輸入收單日期")
  
•   For iI = 2 To iRow
  
•     If Trim(CStr(Cells(iI, 4))) = Trim(CStr(vDate)) Then
  
•       If sDate <> CStr(Cells(iI, 1)) Then
  
•         sStr = sStr + Chr(10) + CStr(Cells(iI, 1)) + " : " + CStr(oD(CStr(Cells(iI, 1))))
  
•         sDate = CStr(Cells(iI, 1))
  
•       End If
  
•     End If
  
•   Next iI
  
•   MsgBox "收單日期 : " + vDate + " 的數量" + sStr
  
• End Sub
  

感謝前輩的回答
只是跑出來的數量是空白的
小弟是個新手,樞紐也只是用excel裡的功能,並非是用VBA
另外請教Trim及CStr是什麼作用?
還有sStr$及iRow%,後面加上"$"及"%",是要做什麼的?
謝謝您

akimunekyo

回復 8# Hsieh


謝謝
再請教要如何將程式碼像前輩一樣用表格貼上,前面還可以加上序號?