- 帖子
- 976
- 主題
- 7
- 精華
- 0
- 積分
- 1018
- 點名
- 0
- 作業系統
- Win10
- 軟體版本
- Office 2016
- 閱讀權限
- 50
- 性別
- 男
- 註冊時間
- 2013-4-19
- 最後登錄
- 2024-12-18
|
2#
發表於 2022-5-24 16:24
| 只看該作者
各位前輩好，
想以字典方式比對兩表後將結果輸出，
但寫一半又卡住了...請問有人可以提供解法/思維嗎，
...
shuo1125 發表於 2022-5-24 15:17 
請測試看看，謝謝
Sub test()
Dim Arr, xD, Brr(), T$, T1$, i&, n%
Set xD = CreateObject("Scripting.Dictionary")
Arr = Sheet1.[A1].CurrentRegion
For i = 2 To UBound(Arr)
T = Arr(i, 3): T1 = Arr(i, 5)
If UCase(T1) = "S" Then
xD(T) = Array(Arr(i, 4), Arr(i, 7))
End If
Next
Arr = Sheet2.[A1].CurrentRegion
ReDim Brr(1 To UBound(Arr), 1 To 7)
For i = 2 To UBound(Arr)
T = Arr(i, 1)
If xD.Exists(T) Then
n = n + 1: Brr(n, 3) = xD(T)(1)
Brr(n, 1) = T: Brr(n, 2) = Arr(i, 2)
If UCase(xD(T)(0)) = "DR" Then
If Arr(i, 10) > Arr(i, 11) Then
Brr(n, 7) = Arr(i, 10)
Else
Brr(n, 7) = Arr(i, 11)
End If
ElseIf UCase(xD(T)(0)) = "CR" Then
If Arr(i, 10) > Arr(i, 11) Then
Brr(n, 7) = -Arr(i, 10)
Else
Brr(n, 7) = -Arr(i, 11)
End If
End If
End If
99: Next
If n > 0 Then
Sheet3.[A8].Resize(n, 7) = Brr
End If
End Sub |
-
-
1.JPG
(165.27 KB)
|
