- 帖子
- 1446
- 主題
- 40
- 精華
- 0
- 積分
- 1470
- 點名
- 0
- 作業系統
- Windows 7
- 軟體版本
- Excel 2010 & 2016
- 閱讀權限
- 50
- 性別
- 男
- 來自
- 台灣
- 註冊時間
- 2020-7-15
- 最後登錄
- 2024-10-21
|
12#
發表於 2024-2-29 07:41
| 只看該作者
回復 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 |
|
