VBA 加總數值

518587

你好，請問各位大大

目前幾個問題，想請教各位大大的幫
1、如何透過VBA將字串201101010001提出前八個號碼然後加上2011/01/01變成日期
2、將同一天日期所使用的數量做數量的加總

我知道如何用手工操作控制，但是數量太龐大沒辦法一個一個用，所以想要透過VBA執行

拜託各位神人幫幫忙~~~~~

PS.由於會員還是小學生，不能下載檔案，可否將程式碼貼在留言上，不好意思!!!!

yen956

設 201101010001 在 A2
B2公式
=DATE(LEFT($A2,4),MID($A2,6,2),MID($A2,8,2))
日期格式設為
yyyy/mm/dd

Hsieh

回復 1# 518587

1. Sub ex()
   
2. Set d = CreateObject("Scripting.Dictionary")
   
3. For Each a In Range([A1], [A1].End(xlDown)) '資料再A欄
   
4.    d(Format(Mid(a, 1, 8), "0000/00/00")) = d(Format(Mid(a, 1, 8), "0000/00/00")) + Val(Mid(a, 9))
   
5. Next
   
6. [D1].Resize(d.Count, 1) = Application.Transpose(d.keys) '日期放到D欄
   
7. [E1].Resize(d.Count, 1) = Application.Transpose(d.items) '數量加總放到E欄
   
8. End Sub

複製代碼

518587

回復 3# Hsieh


    你好，感謝您的幫助，:)

但是有些小問題想請教您，
[M1].Resize(d.Count, 1) = Application.Transpose(d.items) '數量加總放到E欄
這個是加總哪裡的數量?!

圖片是我的資料，但是我發現一個問題就是日期沒有連續
可能因為資料中有些日期沒有，如果要加上日期可以連續就算沒有資料也可以出現日期嗎?!

GBKEE

回復 4# 518587

d(Format(Mid(a, 1, 8), "0000/00/00")) = d(Format(Mid(a, 1, 8), "0000/00/00")) + Val(Mid(a, 9))

是日期的加總

可能因為資料中有些日期沒有，如果要加上日期可以連續就算沒有資料也可以出現日期嗎?!

看不懂

1. Option Explicit  'B欄數量的加總
   
2. Sub Ex()
   
3.     Dim D As Object, A As Range, K As Long, I As Long
   
4.     Set D = CreateObject("Scripting.Dictionary")    '字典物件
   
5.     For Each A In Range([A1], [A1].End(xlDown))     '資料在A欄
   
6.         D(Val(Mid(A, 1, 8))) = D(Val(Mid(A, 1, 8))) + A.Offset(, 1)  '數量在B欄的加總
   
7.         'Val(Mid(A, 1, 8)) 轉為數字
   
8.     Next
   
9.     [D:E].Clear
   
10.     For I = 1 To D.Count  '最小值到最大值
    
11.         K = Application.WorksheetFunction.Small(D.KEYS, I)
    
12.         [D1].Offset(I - 1) = Format(K, "0000/00/00")  '轉為日期格式
    
13.         [E1].Offset(I - 1) = D(K)                '數量加總
    
14. 
    
15.     Next
    
16. End Sub

複製代碼

Hsieh

回復 4# 518587

1. Sub ex()
   
2. Dim k#
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. For Each a In Range([A1], [A1].End(xlDown)) '資料再A欄
   
5. k = DateValue(Format(Mid(a, 1, 8), "0000/00/00"))
   
6.    d(k) = d(k) + a.Offset(, 1) '數量在B欄
   
7. Next
   
8. [D:E] = "" '清空舊資料
   
9. r = 1
   
10. For i = Application.Min(d.keys) To Application.Max(d.keys) '最小日期到最大日期寫入
    
11. Cells(r, 4) = CDate(i)
    
12. Cells(r, 5) = d(i)
    
13. r = r + 1
    
14. Next
    
15. End Sub

複製代碼

518587

回復 5# GBKEE


    版大你好，感謝您提供的方法也謝謝願意提供幫助

附上圖片，D欄與E欄是由版大提供的程式碼所跑出來的結果
但是D欄沒有包含所有的日期，比對G欄會發現D欄日期不是完整的，有缺少幾天

518587

回復 6# Hsieh


感謝大大的幫忙，但是這段程式碼，
無法執行，發生型態不符合的狀況

試著要找出問題，但是還是無法找出到底是哪裡型態錯誤...
對不起，只會單純初階的VBA語法

GBKEE

回復 7# 518587
請附檔看看

Hsieh

回復 8# 518587

上面的程式會出錯，大概是日期部分
程式是由A1開始，因為你的資料有標題
將範圍從A2開始應該就可行