[發問] 刪除重複後，尋找重複客戶號碼加總值

Changbanana

請教各位高手~
現有個工作表

下載 (115.51 KB)

2016-9-26 10:53

已經用

1. Sub 移除單號重複()
   
2. Set dic = CreateObject("scripting.dictionary")
   
3. For i = Range("G65536").End(3).Row To 1 Step -1
   
4. If dic.Exists(Cells(i, "G").Value) Then
   
5. Rows(i).Delete
   
6. Else
   
7. dic(Cells(i, "G").Value) = ""
   
8. End If
   
9. Next i
   
10. End Sub

複製代碼

刪除單號重複的
但之後需要依客戶編號(A欄)  若有相同的編號 需要加總E欄
(G欄單號可忽略 他是拿來避免單號KEY重複)
想請問該怎麼繼續做呢?
最後想呈現的結果

下載 (39.18 KB)

2016-9-26 10:58

附件: 測試.zip (510.46 KB)

下載次數: 9

2016-9-26 11:02

Kubi

回復 1# Changbanana

看起來你的索引KEY除了客戶編號之外，還須包括B欄的sell作為KEY值，才合乎你想呈現的結果吧？

Changbanana

回復 2# Kubi

    抱歉抱歉
    B欄忘記改了
   KEY 值只有A欄
   

下載 (24.83 KB)

2016-9-26 14:20

    10301==>小明
    10302==>大雄
    10303==>筱華
   
    其他資料可以忽略
    主要KEY 值是A 欄 A欄一樣的加總E欄(合併)

Kubi

回復 3# Changbanana
可是編號10302包括大雄與小明，如何區別？

Changbanana

回復 4# Kubi


    10302一定是大雄
   
    檔案沒改到
    更新過的檔案: 測試.rar (349.5 KB)

下載次數: 19

2016-9-26 20:04

Kubi

回復 5# Changbanana
試看看。
結果會寫在I:O欄

1. Sub test()
   
2.     Dim arr()
   
3.     Dim dic As Object
   
4.     Set dic = CreateObject("scripting.dictionary")
   
5.     For i = 2 To Range("A65536").End(3).Row
   
6.         If dic.Exists(Cells(i, 1).Value) Then
   
7.             dic(Cells(i, 1).Value) = dic(Cells(i, 1).Value) + Cells(i, 5).Value
   
8.         Else
   
9.             dic(Cells(i, 1).Value) = Cells(i, 5).Value
   
10.             n = n + 1
    
11.             ReDim Preserve arr(1 To 7, 1 To n)
    
12.             For j = 1 To 7
    
13.                 arr(j, n) = Cells(i, j).Value
    
14.             Next j
    
15.         End If
    
16.     Next i
    
17.     For i = 1 To n: arr(5, i) = dic(arr(1, i)): Next i
    
18.     Columns("I:O").ClearContents
    
19.     [I1].Resize(1, 7) = [A1].Resize(1, 7).Value
    
20.     [I2].Resize(n, 7) = Application.Transpose(arr)
    
21. End Sub

複製代碼

Changbanana

回復 6# Kubi


感謝k大的大力相助~
跑出結果是正確的
想請教一下

1.       ReDim Preserve arr(1 To 7, 1 To n)
   
2.             For j = 1 To 7
   
3.                 arr(j, n) = Cells(i, j).Value
   
4.             Next j

複製代碼

這個用法可不可以解說一下~ 謝謝您:)

Kubi

回復 7# Changbanana
簡單來說就是從資料端擷取某列資料儲存於二維陣列(arr)中備用。
至於 ReDim 請參閱官方版說明(游標停在ReDim文字中後再按F1鍵)，會比我解釋的更清楚。

准提部林

Sub TEST()
Dim Arr, Brr, xD, T&, i&, j%, U&, N&
Arr = Range([A1], [A65536].End(xlUp)(1, 7))
Set xD = CreateObject("scripting.dictionary")
ReDim Brr(1 To UBound(Arr), 1 To 7)
For i = 2 To UBound(Arr)
　　T = Arr(i, 1): U = xD(T)
　　If U > 0 Then Brr(U, 5) = Brr(U, 5) + Arr(i, 5): GoTo 101
　　N = N + 1: U = N: xD(T) = N
　　For j = 1 To 7: Brr(U, j) = Arr(i, j): Next
101: Next i
If N > 0 Then [J1].Resize(N, 7) = Brr
End Sub

同樣邏輯，不同寫法，自行去揣摩～～
上網去找 字典檔 及 array陣列 的資料及說明，瞭解了，其它都簡單！
　
　

Changbanana

回復 8# Kubi

回復 9# 准提部林


  好的~~~謝謝K大和准大~~
  我再慢慢研究
  謝謝你們的回覆^^