samwang

¦U¦ì«e½ú¦n¡A
·Q¥H¦r¨å¤è¦¡¤ñ¹ï¨âªí«á±Nµ²ªG¿é¥X¡A
¦ý¼g¤@¥b¤S¥d¦í¤F...½Ð°Ý¦³¤H¥i¥H´£¨Ñ¸Ñªk/«äºû¶Ü¡A
...
shuo1125 µoªí©ó 2022-5-24 15:17

½Ð´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
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