請教如何篩選列出不重覆資料並加總數量

074063

請教如何篩選列出不重覆資料並加總數量, 如附件

A、B欄為原始資料
1) 如何使用函數或VBA將 F 欄篩選列出 A 欄不重覆資料
2) G 欄自動加總符合 F 欄位條件的數量 ( 數量來源為 B 欄)

sheet.rar (8.08 KB)

下載次數: 1

2019-7-19 10:39

下載 (29.42 KB)

2019-7-19 10:40

074063

不好意思, 更正重新發問

請教按鈕 vba 如何寫?
1) 複製 data 資料表內 "不重覆" 的料件代號至 sheet1 A欄位
2) 計算加總 data 資料表內料件代號所對應的應發數量 =  sheet1 料件代號

    data.rar (14.27 KB)

下載次數: 7

2019-7-19 13:38

准提部林

Sub update()
Dim Arr, xD, T$, i&, U&, S, N&
[sheet1!A:B].ClearContents
Arr = Range([data!B1], [data!A65536].End(xlUp))
Set xD = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(Arr)
    T = Arr(i, 1):  If T = "" Then GoTo 101
    U = xD(T): S = Val(Arr(i, 2))
    If U = 0 Then
       N = N + 1:   U = N:   xD(T) = N
       Arr(U + 1, 1) = T:    Arr(U + 1, 2) = 0
    End If
    Arr(U + 1, 2) = Arr(U + 1, 2) + S
101: Next
If N = 0 Then Exit Sub
With [sheet1!A1:B1].Resize(N + 1)
     .Columns(1).NumberFormatLocal = "@"
     .Value = Arr
End With
End Sub

================================

Andy2483

回復 3# 准提部林


    謝謝論壇,謝謝前輩
後學藉此帖學習前輩的方案,方案學習心得註解如下,請前輩再指導

執行前:

下載 (128.51 KB)

2023-6-2 07:46

執行結果:

下載 (137.08 KB)

2023-6-2 07:47

Sub update()
Dim Arr, xD, T$, i&, U&, S, N&
'↑宣告變數
[sheet1!A:B].ClearContents
'↑令結果表A~B欄清除內容
Arr = Range([data!B1], [data!A65536].End(xlUp))
'↑令Arr變數是 二維陣列,以date表A~B欄資料帶入陣列中
Set xD = CreateObject("Scripting.Dictionary")
'↑令xD變數是 字典
For i = 2 To UBound(Arr)
'↑設順迴圈
    T = Arr(i, 1):  If T = "" Then GoTo 101
    '↑令T變數是陣列第1欄字串值;如果T變數是空字元,就跳到101位置繼續執行
    U = xD(T): S = Val(Arr(i, 2))
    '↑令U變數是 以T變數查xD字典回傳item,令S變數是 陣列第2欄值轉數值
    If U = 0 Then
    '↑如果U變數是0?
       N = N + 1:   U = N:   xD(T) = N
       '↑令N變數累加1(累計結果資料最後列號),令U變數是N變數值,
       '令T變數當key,item是N變數(令字典幫記住結果料件代號在哪一列的下一列?)
       Arr(U + 1, 1) = T:    Arr(U + 1, 2) = 0
       '↑令U+1列第1欄Arr陣列值是 T變數(料件代號)
       '↑令U+1列第2欄Arr陣列值是 0 (因為用同一陣列寫入結果資料!先歸零)
       '(U+1是為了保留標題列)
    End If
    Arr(U + 1, 2) = Arr(U + 1, 2) + S
    '↑令U+1列第2欄Arr陣列值累加 S變數(應發數量)
101: Next
If N = 0 Then Exit Sub
'↑如果N變數(沒有重複的 料件代號),就結束程式執行
With [sheet1!A1:B1].Resize(N + 1)
'↑以下是表1從[A1:B1]開始向下擴展(N+1)列的儲存格範圍,關於這範圍程序
     .Columns(1).NumberFormatLocal = "@"
     '↑令這範圍的第1欄儲存格格式是文字
     .Value = Arr
     '↑令這範圍儲存格值是Arr陣列值,超過這範圍的陣列值忽略
End With
End Sub

Andy2483

謝謝論壇,謝謝各位前輩
後學藉此帖練習陣列與字典,學習方案使用2個陣列方案如下,請各位前輩指教


Option Explicit
Sub TEST()
Dim Brr, Crr, Y, R&, i&, T1$, T2$, K&
Dim xRd As Range, Shd As Worksheet, Sha As Worksheet
'↑宣告變數
Set Y = CreateObject("Scripting.Dictionary")
'↑令Y變數是 字典
Set Shd = Sheets("data"): Set Sha = Sheets("sheet1"): Sha.[A:B].ClearContents
'↑令變數裝入物件(工作表),令結果表清除舊資料
Set xRd = Range(Shd.[B1], Shd.Cells(Rows.Count, 1).End(xlUp))
'↑令xRd變數裝入物件(資料表A~B欄儲存格)
Brr = xRd: K = UBound(Brr): ReDim Crr(1 To K, 1 To 2)
'↑令Brr變數是 二維陣列,以xRd變數值帶入陣列中,
'令K變數是Brr陣列縱向最大索引列號,
'令Crr變數是 二維空陣列,宣告他的範圍縱向同Brr陣列,橫向1~2索引號
For i = 1 To K
'↑設順迴圈
   T1 = Brr(i, 1): T2 = Brr(i, 2)
   '↑令變數裝入陣列值,成為字串變數
   If i = 1 Then R = R + 1: Crr(i, 1) = T1: Crr(i, 2) = T2: GoTo i01
   '↑如果i迴圈是 1!就令R是0+1,令Crr陣列標題列同Brr陣列,令跳到i01位置繼續執行
   If Y(T1) = "" Then R = R + 1: Y(T1) = R: Crr(R, 1) = T1
   '↑如果以T1變數查Y字典回傳item是空字元(初次納入字典),就令R變數+1(累計列號)
   '令在Y字典中key是 T1變數的item換成是 R變數(記住 料件代號是放在Crr哪一列)
   '令Crr陣列寫入該 料件代號
   Crr(Y(T1), 2) = Crr(Y(T1), 2) + Val(T2)
   '↑令Crr陣列第2欄累加 應發數量
i01: Next
Sha.[A:A].NumberFormatLocal = "@"
'↑令結果表A欄儲存格格式是文字
Sha.[A1].Resize(R, 2) = Crr
'↑令結果表[A1]擴展範圍帶入Crr陣列值,超過此範圍的Crr陣列值忽略
Set Y = Nothing: Set xRd = Nothing: Set Shd = Nothing
Set Sha = Nothing: Erase Brr, Crr
'↑令釋放變數
End Sub