Board logo

標題: [發問] 請教：四個條件下的累計 [打印本頁]
作者: storylai    時間: 2011-12-12 17:39     標題: 請教：四個條件下的累計

有一系列檔案，每個共 8 個欄位，
每個檔案約有 300 ~1500 個記錄，
檔案結構如下：

  A    B     C     D       E         F
日期  崗位  姓名  顧客  工作地點  銷售金額

要求：在主檔的 bReport 中彙總出以下資料：

1- 假如 b c d e 欄相同的，則累加 f 欄。
2- 只要 b c d e 欄有一項不同的，則分列出來。

如：

  A    B      C       D       E         F
日期  崗位   姓名    顧客  工作地點  銷售金額
10/12   A    張三    陳生    店一     50000
10/12   B    張三    陳生    店二     40000
10/12   A    張三    李生    店一     30000
10/12   C    張三    李生    店一     20000
10/12   C    張三    李生    店一     10000
10/12   A    張三    陳生    店一     65000

如果：

  A    B      C       D       E         F
日期  崗位   姓名    顧客  工作地點  銷售金額
10/12   A    張三   陳生     店一      115000
10/12   B    張三   陳生     店二       40000
10/12   A    張三   李生     店一       30000
10/12   C    張三   李生     店一       30000


弄了幾天都搞不定，只好向各位大大求救。先謝了。
作者: storylai    時間: 2011-12-12 17:43

忘了一點，自論壇換了新系統後，
我又變回小學生，不能下載檔案了。
作者: Hsieh    時間: 2011-12-12 17:53

回復 2# storylai


    樞紐分析表就能輕鬆達成
[attach]8795[/attach]
作者: storylai    時間: 2011-12-12 21:49

回復  storylai


    樞紐分析表就能輕鬆達成
Hsieh 發表於 2011-12-12 17:53


謝謝回應。
問題是：
1- 另一個部門要「一行一行」的記錄來做分析。
2- 想用 VBA 做，因為每天要由其它大姐來處理十多個檔案。

我是先將檔案的資料讀入「數組」，然後用迴圈來一個一個對比，
但技術不精，總有許多問題。真頭疼。
作者: register313    時間: 2011-12-12 22:14

本帖最後由 register313 於 2011-12-12 22:19 編輯

回復 4# storylai

      用 資料/小計 可以嗎
    1.在G欄加入輔助欄(BCDE欄之結合)
      2.G欄要排序
    3.資料/小計
    [attach]8799[/attach]
      4.結果
    [attach]8798[/attach]
作者: Hsieh    時間: 2011-12-12 22:36

  1. Sub Ex()
  2. Set d = CreateObject("Scripting.Dictionary")
  3. For Each a In Range([A2], [A2].End(xlDown))
  4.    mystr = Join(Application.Transpose(Application.Transpose(a.Resize(, 5))), ",")
  5.    d(mystr) = d(mystr) + a.Offset(, 5)
  6. Next
  7. [A1:F1].Copy [I1]
  8. For Each ky In d.keys
  9. ar = Split(ky, ",")
  10. ar(0) = CDate(ar(0))
  11. [I2].Offset(i, 0).Resize(, 5) = ar
  12. [I2].Offset(i, 5) = d(ky)
  13. i = i + 1
  14. Next
  15. End Sub
複製代碼
回復 4# storylai
作者: storylai    時間: 2011-12-13 12:11

回復 6# Hsieh

謝謝，可用了。
很厲害，比我原來寫了 50 多行的還快速。

想請教：
05.   d(mystr) = d(mystr) + a.Offset(, 5)

         mystr 是我要求的四個條件，那  d(mystr)  是把它們放進 d 。
          a.Offset(, 5) ，我試出來是銷售額。
      
     就是不明白這句的用意。是不是就是在做「銷售額的累加」？
作者: storylai    時間: 2011-12-16 13:03

本帖最後由 storylai 於 2011-12-16 13:05 編輯

回復 6# Hsieh

似乎看懂了 Hsieh 大的程式了。請大家指教。

Sub Ex2()
   
    Set d = CreateObject("Scripting.Dictionary") '建立一個 d 字典(容器)
    For Each a In Range([A2], [A2].End(xlDown))  '建立迴圈，順序讀入每一列 rows 資料
                                                 ' [A2].End(xlDown) 是取得有資料的最後一欄
                                                 '
        ' 使用雙 Transpose ，可參閱：
        ' http://forum.twbts.com/redirect. ... 081&fromuid=459
        '
        ' mystr 是數組 array ，目的是將第一列全寫全變數，格式為 "A2,B2,C2,C2,C2"
        ' a.Resize(, 5) 是定義好 由 A2 向右延展至第 5 個儲存格，即 C2
        mystr = Join(Application.Transpose(Application.Transpose(a.Resize(, 5))), ",")
        '
        ' d(mystr)       第一步，按迴圈將 mystr 數組入為「索引 index/keys」放入 d 字典中
        ' a.Offset(, 5)  第二步，同時用 a.Offset(, 5) ，將 6 欄的「銷售金額」作為 content/items 放入 d 字典中
        '
        ' 重點是，當執行迴圈時， d 會自行檢索 「索引 index/keys」中是否已有 mystr 這個索引。
        '         如沒有的，會自動新 mystr : a.Offset(, 5)
        '         如已有的，會自動累計 a.Offset(, 5) 的值。
        '                   累計時，數字會相加，文字會串列，若不同類型會報錯。
        '
        d(mystr) = d(mystr) + a.Offset(, 5)
        '
    Next   ' 迴圈結束後，有關的資料處理已完成。等待下一步的寫入
   
    [A1:F1].Copy [I1]   '將標題列複製至 I1欄。
   
    '開始於 I1 欄寫回 d 字典的資料
    For Each ky In d.keys                       ' 用 ky 變數逐步處理 d.keys(d 字典的索引)
            ar = Split(ky, ",")                 ' 利用 Split 按 , 分割，並存入 ar 數組
            ar(0) = CDate(ar(0))                ' 用 CDate 函數將 數字 變回日期格式
            [I2].Offset(i, 0).Resize(, 5) = ar  ' 寫入"日期 / 崗位 / 姓名 / 顧客 / 工作地點" 的值(d索引)
            [I2].Offset(i, 5) = d(ky)           ' 寫入"銷售金額" 的值(d值)
            i = i + 1
    Next
End Sub
作者: Andy2483    時間: 2023-3-30 09:44

回復 8# storylai


    謝謝論壇,謝謝前輩發表此主題與範例檔
後學藉此主題練習陣列與字典,運用key數量為指定新結果資料在陣列的列位置
以下是後學學習方案,請前輩參考

執行前:
[attach]36059[/attach]

執行結果:
[attach]36060[/attach]


Option Explicit
Sub TEST()
Dim Brr, T, Y, xR, i&, N&, j%
'↑宣告變數:(Brr,T,Y,xR)是通用型變數,(i,N)是長整數變數,j是短整數變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y這通用型變數是 字典
Set xR = Range([F1], Cells(Rows.Count, 1).End(3)): Brr = xR
'↑令xR這通用型變數是 [F1]到A欄最後有內容儲存格,
'令Brr這通用型變數是 二維陣列,以xR變數值帶入陣列裡
For i = 2 To UBound(Brr)
'↑設順迴圈!i從2到 Brr陣列縱向最大索引列號
   For j = 1 To 5: T = T & "|" & Brr(i, j): Next
   '↑設順迴圈!j從1到 5:令T這通用型變數是 自身連接"|" 再連接
   'i迴圈列j迴圈欄Brr陣列值之後的新字串
   If Y(T) = "" Then
   '↑如果以T變數查Y字典的item值是 空字元??
      Y(T) = Y.Count + 1: N = Y(T)
      '↑令以T變數為key,item是 Y字典key數量+1的數值,
      '令N這長整數變數是 T變數查Y字典的item值
      For j = 1 To 6:  Brr(N, j) = Brr(i, j): Next
      '↑設順迴圈!j從1到 6:令N變數列第j變數欄Brr陣列值是
      'i變數列第j變數欄Brr陣列值
      Else
         N = Y(T): Brr(N, 6) = Brr(N, 6) + Brr(i, 6)
         '↑令N這長整數變數是 T變數查Y字典的item值,
         'N變數列第6欄Brr陣列值是自身 + i變數列第6欄Brr陣列值
   End If
   T = ""
    '↑令T變數是空字元
Next
With xR.Offset(0, 8).Resize(Y.Count + 1, 6)
'↑以下是關於xR變數向右偏移8欄後從第1格擴展,
'擴展向下Y字典key數量+1列,向右擴展6欄,關於此範圍儲存格程序
   .EntireColumn.ClearContents
   '↑令這些儲存格所在的欄位儲存格值清空
   .Value = Brr
   '↑令這些儲存格值以Brr陣列值帶入
End With
Set Y = Nothing: Set xR = Nothing: Erase Brr
'↑釋放變數
End Sub



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