Public flZD, jf1ZD, jf2ZD, jf3ZD
Public jgArr(1 To 6) As Double '價格數組
Const ksLh1 = 1
Const ksLh2 = 9
Const ksLh3 = 15
Sub jgJs()
'2018-07-29編制
'裴老師vba工作室 TEL：18896773754 QQ：3030490161
'flZD 'key-省份 item-類別（1,2,3）
Dim hH As Long, lH As Integer, zL As Double
Dim qY As String
Dim szJe As Double, xzJe As Double, czJe As Double '首重金額 續重金額 超重金額
'字典初始化
Set flZD = CreateObject("scripting.dictionary")
Set jf1ZD = CreateObject("scripting.dictionary")
Set jf2ZD = CreateObject("scripting.dictionary")
Set jf3ZD = CreateObject("scripting.dictionary")
With Sheets("新價格表")
For i = 1 To 3
Select Case i
Case 1
lH = ksLh1
Case 2
lH = ksLh2
Case 3
lH = ksLh3
End Select
hH = 4
Do While .Cells(hH, lH) <> ""
qY = .Cells(hH, lH).Text
flZD.Add qY, i
Select Case i
Case 1
jf1ZD.Add qY, hH
Case 2
jf2ZD.Add qY, hH
Case 3
jf3ZD.Add qY, hH
End Select
hH = hH + 1
Loop
Next i
End With
hH = 2
Do While Cells(hH, 4) <> ""
qY = Cells(hH, 6).Text
zL = Cells(hH, 4).Value
Call js_zcx(qY, zL, szJe, xzJe, czJe)
Cells(hH, 8) = szJe
Cells(hH, 9) = xzJe
Cells(hH, 10) = czJe
Cells(hH, 11) = szJe + xzJe + czJe
hH = hH + 1
Loop
End Sub
Sub js_zcx(qY, zL, ByRef szJe, ByRef xzJe, ByRef czJe)
Dim lB As Integer, hH As Long
lB = flZD(qY)
Select Case lB
Case 1
hH = jf1ZD(qY)
For i = 1 To 6
jgArr(i) = Sheets("新價格表").Cells(hH, ksLh1 + i).Value
Next i
Case 2
hH = jf2ZD(qY)
For i = 1 To 4
jgArr(i) = Sheets("新價格表").Cells(hH, ksLh2 + i).Value
Next i
Case 3
hH = jf3ZD(qY)
For i = 1 To 5
jgArr(i) = Sheets("新價格表").Cells(hH, ksLh3 + i).Value
Next i
End Select
Select Case lB
Case 1 '計算
Select Case zL
Case Is > 3
szJe = jgArr(5)
xzJe = 0.5 * Application.WorksheetFunction.RoundUp((zL - 1) / 0.5, 0) * 2 * jgArr(6)
czJe = 0
Case 1.01 To 3
szJe = jgArr(3)
xzJe = 0.5 * Application.WorksheetFunction.RoundUp((zL - 1) / 0.5, 0) * 2 * jgArr(4)
czJe = 0
Case 0.51 To 1
szJe = jgArr(3)
xzJe = 0
czJe = 0
Case 0.31 To 0.5
szJe = jgArr(2)
xzJe = 0
czJe = 0
Case Is <= 0.3
szJe = jgArr(1)
xzJe = 0
czJe = 0
End Select
Case 2 '計算
Select Case zL
Case Is > 1
szJe = jgArr(3)
xzJe = Application.WorksheetFunction.RoundUp((zL - 1), 0) * jgArr(4)
czJe = 0
Case 0.51 To 1
szJe = jgArr(3)
xzJe = 0
czJe = 0
Case 0.31 To 0.5
szJe = jgArr(2)
xzJe = 0
czJe = 0
Case Is <= 0.3
szJe = jgArr(1)
xzJe = 0
czJe = 0
End Select
Case 3 '計算
Select Case zL
Case Is > 1
szJe = jgArr(4)
xzJe = 0.5 * Application.WorksheetFunction.RoundUp((zL - 1) / 0.5, 0) * 2 * jgArr(5)
czJe = 0
Case 0.51 To 1
szJe = jgArr(3)
xzJe = 0
czJe = 0
Case 0.31 To 0.5
szJe = jgArr(2)
xzJe = 0
czJe = 0
Case Is <= 0.3
szJe = jgArr(1)
xzJe = 0
czJe = 0
End Select
End Select
End Sub