198188

回復 2# Andy2483

我加了一句 刪除之前的資料，和修改了H10 & J10 為開始

Option Explicit
Sub TEST2()
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

Range([O10], [J65536].End(xlUp)(3)).Delete Shift:=xlUp

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 & "Repeat":  Exit Sub
      Else
      Z(T) = Val(Brr(i, 5))
      Z(T & "/n") = 1
   End If
Next
Arr = Range([Invoice!H10], [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 & "Repeat":  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!J10].Resize(UBound(Crr), 6) = Crr
End Sub

Andy2483

回復 11# 198188

謝謝前輩一起學習
後學複習方案心得註解如下,請試了解後運用
Option Explicit
Sub TEST()
Dim Arr, Brr, Crr, V, Z, i&, T$
'↑宣告變數
Set Z = CreateObject("Scripting.Dictionary")
'↑令Z變數是 字典
Brr = Range([Data!E2], [Data!A65536].End(3))
'↑令Brr變數是二維陣列,以工作表範圍儲存格值帶入
For i = 1 To UBound(Brr)
'↑設順迴圈!
   T = Trim(Brr(i, 1)) & "/" & Val(Brr(i, 2)) & "/" & Val(Brr(i, 3))
   '↑令T變數是1欄字串.2欄數值與3欄數值以"/"符號串接成的新字串
   If Z.EXISTS(T) Then
   '↑如果Z字典裡有T變數這key
      MsgBox T & "重複":  Exit Sub
      '↑代表資料有重複,跳出提示窗,按確定後結束程式執行
      Else '否則
      Z(T) = Val(Brr(i, 5))
      '↑令以T變數為key,5欄數值為item 納入Z字典中
      Z(T & "/n") = 1
      '↑令以T變數連接"/n"組成的新字串為key,1為item 納入Z字典中
   End If
Next
Arr = Range([Invoice!H12], [Invoice!C65536].End(3))
'↑令Arr變數是二維陣列,以工作表範圍儲存格值帶入
ReDim Crr(1 To UBound(Arr), 1 To 6)
'↑宣告Crr變數是二維空陣列,並宣告其範圍
For i = 1 To UBound(Arr)
'↑設順迴圈!
   If Trim(Arr(i, 1)) = "" Then GoTo i01
   '↑如果1欄陣列值去除頭尾空白字元後 是空字元,就跳到標示i01位置繼續執行
   T = Trim(Arr(i, 1)) & "/" & Val(Arr(i, 2)) & "/" & Val(Arr(i, 3))
   Z(T & "/n") = Z(T & "/n") + 1
   '↑令item值累加1
   If Z(T & "/n") > 2 Then MsgBox T & "重複":  Exit Sub Else V = Z(T)
   '↑代表資料有重複,跳出提示窗,按確定後結束程式執行,否則就令V變數是以T變數查Z字典得到的item值
   If V = "" Then GoTo i01
   '↑如果V變數是空字元,就跳到標示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))
   '↑令以Arr陣列值依需求計算後帶入 Crr陣列中
i01: Next
[Invoice!J12].Resize(UBound(Crr), 6) = Crr
'↑令Crr陣列值寫入儲存格中
End Sub