- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
2#
發表於 2024-2-27 14:34
| 只看該作者
本帖最後由 Andy2483 於 2024-2-27 15:20 編輯
回復 1# 198188
謝謝前輩發表此主題與範例
後學藉此帖學到了 ROUND() 很多知識,學習方案如下,請前輩參考
https://learn.microsoft.com/zh-t ... help/round-function
Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, V, Z, Q, i&, j%, R&, c%, Y&, X%, T$, T1$, T2$, T3$
Dim xR As Range, Ra As Range, Sh As Worksheet, xBook As Workbook
Set Z = CreateObject("Scripting.Dictionary")
Brr = Range([Data!E2], [Data!A65536].End(3))
For i = 1 To UBound(Brr)
T = Trim(Brr(i, 1)) & "/" & Val(Brr(i, 2)) & "/" & Val(Brr(i, 3))
If Z.EXISTS(T) Then
MsgBox T & "重複": Exit Sub
Else
Z(T) = Val(Brr(i, 5))
Z(T & "/n") = 1
End If
Next
Arr = Range([Invoice!H12], [Invoice!C65536].End(3))
ReDim Crr(1 To UBound(Arr), 1 To 6)
For i = 1 To UBound(Arr)
If Trim(Arr(i, 1)) = "" Then GoTo i01
T = Trim(Arr(i, 1)) & "/" & Val(Arr(i, 2)) & "/" & Val(Arr(i, 3))
Z(T & "/n") = Z(T & "/n") + 1
If Z(T & "/n") > 2 Then MsgBox T & "重複": Exit Sub Else V = Z(T)
If V = "" Then GoTo i01
Crr(i, 1) = V
Crr(i, 2) = V - Val(Arr(i, 4))
Crr(i, 3) = Application.Round(Val(Arr(i, 2)) * Val(Arr(i, 3)) / 10 ^ 6, 3)
Crr(i, 4) = Crr(i, 3) - Val(Arr(i, 5))
Crr(i, 5) = Application.Round(Crr(i, 3) * Val(Arr(i, 4)), 3)
Crr(i, 6) = Crr(i, 5) - Val(Arr(i, 6))
i01: Next
[Invoice!J12].Resize(UBound(Crr), 6) = Crr
End Sub |
|
