- 帖子
- 1515
- 主題
- 40
- 精華
- 0
- 積分
- 1539
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 100
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2025-10-31
|
3#
發表於 2023-9-23 07:41
| 只看該作者
回復 1# abc9gad2016
謝謝前輩發表此主題與範例
後學藉此帖練習VBA,學習方案如下,請前輩參考
 2023尾牙金額試算ask.rar (18.83 KB)
執行前:
執行結果:
Option Explicit
Sub TEST()
Dim Brr, Crr, Q, i&, j%, 佔床, y6_11, y3_5, y0_2, N%, N1%, 原價&, 自費&, xA, xB
Set 佔床 = [N3]: Set y6_11 = [N4]: Set y3_5 = [N5]: Set y0_2 = [N6]
Set xA = Range([I2], [A65536].End(xlUp)): Brr = xA: Set xB = [J2].Resize(UBound(Brr), 3)
If [C3] <> "" Then Intersect(xA, [C:C,E:E,G:G,I:L]).ClearContents: xB.ClearContents: Exit Sub
Intersect(xA, [C:C,E:E,G:G,I:L]).ClearContents: xB.ClearContents: Crr = xB
For i = 1 To UBound(Brr)
For j = 3 To 9 Step 2: Brr(i, j) = 0: Next
N = N + 1: Q = Val(Brr(i, 2)): 原價 = 佔床
For j = 1 To Q
Brr(i, 3) = Brr(i, 3) + 佔床(1, j + 1)
原價 = 原價 + 佔床
Next
自費 = 自費 + Brr(i, 3)
If Q > 0 Then N = N + 1
If Val(Brr(i, 4)) = 0 Then
Brr(i, 5) = 0
Else
For j = 2 To Val(Brr(i, 4)) + 1:
Brr(i, 5) = Brr(i, 5) + y6_11(1, j - (Q > 0)): 原價 = 原價 + y6_11
Next
End If
自費 = 自費 + Brr(i, 5)
If Brr(i, 4) > 0 And Q <= 1 Then N = N + 1
If Val(Brr(i, 6)) = 0 Then
Brr(i, 7) = 0
Else
For j = N To Val(Brr(i, 6)) + N - 1
Brr(i, 7) = Brr(i, 7) + y3_5(1, j + 1): 原價 = 原價 + y3_5
Next
End If
自費 = 自費 + Brr(i, 7)
If Brr(i, 6) > 0 And Q <= 1 Then N = N + 1
If Val(Brr(i, 8)) = 0 Then
Brr(i, 9) = 0
Else
For j = N To Val(Brr(i, 8)) + N - 1
Brr(i, 9) = Brr(i, 9) + y0_2(1, j + 1): 原價 = 原價 + y0_2
Next
End If
自費 = 自費 + Brr(i, 9)
Crr(i, 1) = 原價: Crr(i, 2) = 自費: Crr(i, 3) = 原價 - 自費
N = 0: Q = 0: 原價 = 0: 自費 = 0
Next
xA.Value = Brr
xB.Value = Crr
Erase Brr, Crr
Set 佔床 = Nothing: Set y6_11 = Nothing: Set y3_5 = Nothing: Set y0_2 = Nothing
Set xA = Nothing: Set xB = Nothing
End Sub |
|
