- 帖子
- 2798
- 主題
- 10
- 精華
- 0
- 積分
- 2854
- 點名
- 0
- 作業系統
- 〔略〕
- 軟體版本
- 〔略〕
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 〔略〕
- 註冊時間
- 2013-5-13
- 最後登錄
- 2024-4-20
|
Sub TEST_A01()
Dim Arr, xD, i&, j%, N&, T$, U&
Set xD = CreateObject("Scripting.Dictionary")
Sheets("工作表2").UsedRange.EntireRow.Delete
Arr = Range([工作表1!I1], [工作表1!A1].Cells(Rows.Count, 1).End(xlUp))
For i = 2 To UBound(Arr)
T = Arr(i, 2) & "|"
If Arr(i, 4) = "組合折扣" Then T = T & "S"
For j = 6 To 9: xD(T & j) = xD(T & j) + Arr(i, j): Next
Next i
'-----------------------------------
For i = 2 To UBound(Arr)
If Arr(i, 4) = "組合折扣" Then GoTo i01
T = Arr(i, 2) & "|"
N = N + 1
For j = 1 To 5: Arr(N + 1, j) = Arr(i, j): Next
For j = 6 To 9
Arr(N + 1, j) = Arr(i, j) + Arr(i, j) * (xD(T & "S" & j) / xD(T & j))
Next j
i01: Next i
'-----------------------------------
[工作表2!A1:I1].Resize(N + 1) = Arr
End Sub
 test1-A01.rar (16.61 KB)
小數不進位, 若要進位, 可能其加總後有因進1或退1所產生的誤差
'===================================== |
|
發表於 2020-10-10 11:52
| 
