刪除重複後，尋找重複客戶號碼加總值 - Excel程式區 - 麻辣家族討論版版

麻辣家族討論版版 » Excel程式區 » 刪除重複後，尋找重複客戶號碼加總值

返回列表下一主題上一主題發帖

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

中學生 Rank: 2

帖子: 163
主題: 1
精華: 0
積分: 170
點名: 0
作業系統: Window 7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2010-9-5
最後登錄: 2022-7-20

1^# 跳轉到 »

發表於 2016-9-26 14:09 | 顯示全部帖子

回復 1# Changbanana

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

中學生 Rank: 2

帖子: 163
主題: 1
精華: 0
積分: 170
點名: 0
作業系統: Window 7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2010-9-5
最後登錄: 2022-7-20

2^#

發表於 2016-9-26 15:25 | 顯示全部帖子

本帖最後由 Kubi 於 2016-9-26 15:34 編輯

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

中學生 Rank: 2

帖子: 163
主題: 1
精華: 0
積分: 170
點名: 0
作業系統: Window 7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2010-9-5
最後登錄: 2022-7-20

3^#

發表於 2016-9-26 21:38 | 顯示全部帖子

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

Sub test()
Dim arr()
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
For i = 2 To Range("A65536").End(3).Row
If dic.Exists(Cells(i, 1).Value) Then
dic(Cells(i, 1).Value) = dic(Cells(i, 1).Value) + Cells(i, 5).Value
Else
dic(Cells(i, 1).Value) = Cells(i, 5).Value
n = n + 1
ReDim Preserve arr(1 To 7, 1 To n)
For j = 1 To 7
arr(j, n) = Cells(i, j).Value
Next j
End If
Next i
For i = 1 To n: arr(5, i) = dic(arr(1, i)): Next i
Columns("I:O").ClearContents
[I1].Resize(1, 7) = [A1].Resize(1, 7).Value
[I2].Resize(n, 7) = Application.Transpose(arr)
End Sub

複製代碼

中學生 Rank: 2

帖子: 163
主題: 1
精華: 0
積分: 170
點名: 0
作業系統: Window 7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2010-9-5
最後登錄: 2022-7-20

4^#

發表於 2016-9-29 15:06 | 顯示全部帖子

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

中學生 Rank: 2

帖子: 163
主題: 1
精華: 0
積分: 170
點名: 0
作業系統: Window 7
軟體版本: Office 2007
閱讀權限: 20
性別: 男
註冊時間: 2010-9-5
最後登錄: 2022-7-20

5^#

發表於 2016-10-2 20:23 | 顯示全部帖子

回復 10# Changbanana

若不要求執行速度的話可用這個。

Sub UseFind()
Dim cell As Range
Columns("I:O").ClearContents
[I1].Resize(1, 7) = [A1].Resize(1, 7).Value
er = 2
For i = 2 To Range("A65536").End(3).Row
Set cell = Columns(9).Find(Cells(i, 1).Value, lookat:=xlWhole)
If cell Is Nothing Then
Cells(er, 9).Resize(1, 7) = Cells(i, 1).Resize(1, 7).Value
er = er + 1
Else
Cells(cell.Row, 13).Value = Cells(cell.Row, 13).Value + Cells(i, 5).Value
End If
Next i
End Sub

複製代碼

靜思自在 : 一句溫暖的話，就像往別人身上灑香水，自己會沾到兩三滴。

返回列表下一主題上一主題