親，程式碼如下。用了字典+陣列，速度更快。附件已上傳。開啟你的Excel檔案，按“Alt+F11”開啟VBA編輯視窗，然後在左側雙擊對應的Sheet，右側空白處貼上下面的程式碼。關閉VBA視窗。然後按“Alt+F8”開啟宏視窗，選擇剛插入的宏，點選“執行”。
Sub tj()Dim d, ADArr, EArrSet d = CreateObject("Scripting.Dictionary")Dim r, i As Longr = Cells(Rows.Count, "A").End(xlUp).RowADArr = Range("A2").Resize(r - 1, 4)EArr = Range("E2").Resize(r - 1, 1)For i = 1 To UBound(ADArr) d(ADArr(i, 1) & ADArr(i, 2) & ADArr(i, 3)) = d(ADArr(i, 1) & ADArr(i, 2) & ADArr(i, 3)) + ADArr(i, 4)NextFor i = 1 To UBound(EArr) If d(ADArr(i, 1) & ADArr(i, 2) & ADArr(i, 3)) >= 10 Then EArr(i, 1) = "大客戶" Else EArr(i, 1) = "小客戶"NextRange("E2").Resize(r - 1, 1) = EArrSet d = NothingEnd Sub
親，程式碼如下。用了字典+陣列，速度更快。附件已上傳。開啟你的Excel檔案，按“Alt+F11”開啟VBA編輯視窗，然後在左側雙擊對應的Sheet，右側空白處貼上下面的程式碼。關閉VBA視窗。然後按“Alt+F8”開啟宏視窗，選擇剛插入的宏，點選“執行”。
Sub tj()Dim d, ADArr, EArrSet d = CreateObject("Scripting.Dictionary")Dim r, i As Longr = Cells(Rows.Count, "A").End(xlUp).RowADArr = Range("A2").Resize(r - 1, 4)EArr = Range("E2").Resize(r - 1, 1)For i = 1 To UBound(ADArr) d(ADArr(i, 1) & ADArr(i, 2) & ADArr(i, 3)) = d(ADArr(i, 1) & ADArr(i, 2) & ADArr(i, 3)) + ADArr(i, 4)NextFor i = 1 To UBound(EArr) If d(ADArr(i, 1) & ADArr(i, 2) & ADArr(i, 3)) >= 10 Then EArr(i, 1) = "大客戶" Else EArr(i, 1) = "小客戶"NextRange("E2").Resize(r - 1, 1) = EArrSet d = NothingEnd Sub