- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
本帖最後由 GBKEE 於 2016-10-2 09:03 編輯
回復 10# Changbanana
不用字典物件 的寫法- Option Explicit
- Sub Ex()
- Dim r As Integer, Ar(), i As Integer
- '*******前置作業
- With Range("A:A").CurrentRegion
- 'CurrentRegion :目前區域,是指以任意空白列及空白欄的組合為邊界的範圍
- .Sort key1:=.Cells(1), order1:=xlAscending, key2:=.Cells(4), order1:=xlAscending, header:=xlYes '排序
- .Columns(1).AdvancedFilter ACTION:=xlFilterCopy, COPYTORANGE:=Cells(1, Columns.Count), Unique:=True
- '進階篩選:進階不重複資料,至於工作表的最右邊的欄位
- End With
- '************************
- r = Cells(Rows.Count, Columns.Count).End(xlUp).Row '計算 篩選 資料數 (客戶編號)
- ReDim Ar(1 To r) '重置陣列大小為 (客戶編號)個數
- Ar(1) = Application.Transpose(Application.Transpose(Range("A1").Resize(, 6))) '表頭 置入陣列
- For i = 2 To r '迴圈 (客戶編號)
- With Range("A:A")
- .Replace Cells(i, Columns.Count), "=1/0" '將 (客戶編號) 改為 錯誤值
- With .SpecialCells(xlCellTypeFormulas, xlErrors).Resize(, 6) '錯誤值的範圍
- .Columns(1) = Cells(i, Columns.Count) ' '將 錯誤值 改回 原 客戶編號
- Ar(i) = Array(.Cells(1).Value, .Cells(2).Value, .Cells(3).Value, .Cells(4).Value, Application.Sum(.Columns(5)), .Cells(.Rows.Count, 6).Value) 'Application.Sum(.Columns(5)) 加總(客戶編號)的CASH
- End With
- End With
- Next
- With Range("I1")
- .Resize(r, 6).EntireColumn = "" '清除舊有資料
- .Resize(r, 6) = Application.Transpose(Application.Transpose(Ar)) '範圍內導入轉置2次的陣列
- End With
- Cells(1, Columns.Count).EntireColumn = "" '清除舊有資料
- End Sub
- '*********************************************************************
- Sub Ex1()
- Dim Rng As Range, Ar(), i As Integer
- '*******前置作業
- With Range("A:A").CurrentRegion
- 'CurrentRegion :目前區域,是指以任意空白列及空白欄的組合為邊界的範圍
- .Sort key1:=.Cells(1), order1:=xlAscending, key2:=.Cells(4), order1:=xlAscending, header:=xlYes '排序
- End With
- '************************
- i = 1
- ReDim Ar(1 To i) '重置陣列大小為 (客戶編號)個數
- Ar(1) = Application.Transpose(Application.Transpose(Range("A1").Resize(, 6))) '表頭 置入陣列
- Set Rng = Range("A2")
- Do While Rng <> "" '客戶編號 <> ""
- i = i + 1
- ReDim Preserve Ar(1 To i)
- With Rng
- Ar(i) = Array(.Cells(1).Value, .Cells(1, 2).Value, .Cells(1, 3).Value, .Cells(1, 4).Value, .Cells(1, 5).Value, .Cells(.Rows.Count, 6).Value)
- End With
- Do While Rng = Rng.Offset(1) '同一 (客戶編號)
- Ar(i)(4) = Ar(i)(4) + Rng.Cells(1, 5) '加總同一 (客戶編號)的CASH
- Ar(i)(5) = Rng.Cells(2, 6)
- Set Rng = Rng.Offset(1) '下一個客戶編號
- Loop
- Set Rng = Rng.Offset(1) '下一個客戶編號
- Loop
- With Range("I1")
- .Resize(, 6).EntireColumn = "" '清除舊有資料
- .Resize(i, 6) = Application.Transpose(Application.Transpose(Ar)) '範圍內導入轉置2次的陣列
- End With
- End Sub
|
|
發表於 2016-10-2 08:53
| 