ªð¦^¦Cªí ¤W¤@¥DÃD µo©«

[µo°Ý] ¨âªí¤ñ¹ï«á±Nµ²ªG¿é¥X

¦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
1.JPG

TOP

¦^´_  samwang
S¤j
´ú¸ÕOK¡A¥i¥H½Ð°Ý¤@¤UxD(T)(1)«á­±³o­Ó(1)¥Nªíªº·N«ä¶Ü..?
ÁÂÁ±z¡I
shuo1125 µoªí©ó 2022-5-24 21:02


¥i¥H½Ð°Ý¤@¤UxD(T)(1)«á­±³o­Ó(1)¥Nªíªº·N«ä¶Ü..?
>>xD(T) = Array(Arr(i, 4), Arr(i, 7))
      xD(T)(0)¨ú¥X Arr(i, 4)
      xD(T)(1)¨ú¥X Arr(i, 7)

TOP

¦^´_  samwang

sam¤j
©êºp¦b§ó¥¿¤@¤U¡A
¥i¯à¬O§Ú»¡©ú¤£°÷²M·¡¡A¬O±N¸Õºâªí¬ì¥Ø¤ñ¹ï°Ñ¼Æ«á¡A
¿é¥X°Ñ¼Æ ...
shuo1125 µoªí©ó 2022-5-25 08:39


§ó·s¦p¬õ¦r³¡¤À¡A½Ð¦A´ú¸Õ¬Ý¬Ý¡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), Arr(i, 2), Arr(i, 10))
    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) = xD(T)(2): Brr(n, 2) = xD(T)(3)
        If UCase(xD(T)(0)) = "DR" Then
        ....
        ....
        ....
1.JPG

TOP

¦^´_  samwang
sam¤j
©êºp¦b½Ð°Ý¡A­Y·Q­n¼W¥[¬ì¥Ø¥h­«¤Î¦X¨Öª÷ÃB..
³o³¡¤À­n¦p¦ó­×§ï¡A¸Ô¦p¹Ï¤ù¡A
¦A¦¸ ...
shuo1125 µoªí©ó 2022-5-31 09:27


¤£¦n·N«ä¡A¬Ý¤£¤ÓÀ´±zªº·N«ä¡A½ÐÁ|¨Ò¸É¥R»¡©ú¤@¤U¡AÁÂÁÂ

TOP

¦^´_  samwang
sam¤j
©êºpªí¹F¤£²M¡A²¨¥¤§´N¬O±N¦P¬ì¥Øª÷ÃB¶×Á`¦¨¤@µ§´N¦n...
­Y¤£²M·¡¸ÔªþÀÉ¡A³Â·Ð±z ...
shuo1125 µoªí©ó 2022-5-31 10:12


½Ð¦A´ú¸Õ¬Ý¬Ý¡AÁÂÁÂ
Sub test()
Dim Arr, xD, Brr(), T$, T1$, i&, n%, n1%
Set xD = CreateObject("Scripting.Dictionary")
Set xD1 = 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, 2), Arr(i, 4), Arr(i, 7), Arr(i, 10))
    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
        T1 = xD(T)(0)
        If xD1.Exists(T1) Then
            n1 = xD1(T1)
            If UCase(xD(T)(1)) = "DR" Then
                If Arr(i, 10) > Arr(i, 11) Then
                    Brr(n1, 7) = Brr(n1, 7) + Arr(i, 10)
                Else
                    Brr(n1, 7) = Brr(n1, 7) + Arr(i, 11)
                End If
            ElseIf UCase(xD(T)(1)) = "CR" Then
                If Arr(i, 10) > Arr(i, 11) Then
                    Brr(n1, 7) = Brr(n1, 7) - Arr(i, 10)
                Else
                    Brr(n1, 7) = Brr(n1, 7) - Arr(i, 11)
                End If
            End If
        Else
            n = n + 1: xD1(T1) = n: Brr(n, 3) = xD(T)(2)
            Brr(n, 1) = xD(T)(0): Brr(n, 2) = xD(T)(3)
            If UCase(xD(T)(1)) = "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)(1)) = "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
    End If
99: Next
If n > 0 Then
    With Sheet3
        .[a7].CurrentRegion.Offset(5, 0) = ""
        .[A8].Resize(n, 7) = Brr
        .[G4] = Now
    End With
    Set xD = Nothing: Erase Arr, Brr
End If
End Sub
1.JPG

TOP

¦^´_  samwang
sam¤j
´ú¸Õ¥i¦æ¡A­Y¦³¤£¸Ñ¤§³B¦b³Ò·Ð§A¤F...
·PÁ¡I
shuo1125 µoªí©ó 2022-5-31 12:41


§ó·s¤@¤U¦p¤U¬õ¦r¡A¥u¬OÅýµ{¦¡ÁY´î¤@¤U¡AÁÂÁÂ

For i = 2 To UBound(Arr)
     T = Arr(i, 1)
     If xD.Exists(T) Then
         T1 = xD(T)(0)
         If xD1.Exists(T1) Then
             n1 = xD1(T1): m = n1
         Else
             n = n + 1: xD1(T1) = n: Brr(n, 3) = xD(T)(2)
             Brr(n, 1) = xD(T)(0): Brr(n, 2) = xD(T)(3): m = n
         End If
         If UCase(xD(T)(1)) = "DR" Then
            If Arr(i, 10) > Arr(i, 11) Then
                Brr(m, 7) = Brr(m, 7) + Arr(i, 10)
            Else
                Brr(m, 7) = Brr(m, 7) + Arr(i, 11)
            End If
         ElseIf UCase(xD(T)(1)) = "CR" Then
            If Arr(i, 10) > Arr(i, 11) Then
                Brr(m, 7) = Brr(m, 7) - Arr(i, 10)
            Else
                Brr(m, 7) = Brr(m, 7) - Arr(i, 11)
            End If
         End If
         
     End If
99:  Next

TOP

¦^´_  samwang
sam¤j
¤Ó·PÁ¤F¡A¥t¥~§Ú·Q½Ð°Ý¤@¤UBrr¸òBrr()¦³¤°»ò®t§O¶Ü...?
shuo1125 µoªí©ó 2022-5-31 14:02


¤£¦n·N«ä¡A«á¾Ç«D¥»¦æ¡A³£¥u¬O¦bºô¯¸¾Çªº¡A²z½×¦Wµü¤£¤ÓÀ´¡AÁ¿¸Ñ¤£¬O«Ü¸Ô²Ó¡A½Ð¨£½Ì¡AÁÂÁÂ

Brr: ±Nexcelªº¼Æ¾Ú¸ê®Æ¸Ë¤Jªº¼Æ²Õ
Brr(): ³]©wªÅ¥Õªº¼Æ²Õ

TOP

        ÀR«ä¦Û¦b : ¤Hªº²´·úªø¦b«e­±¡A¥u¬Ý¨ì§O¤Hªº¯ÊÂI¡Aµ·²@¬Ý¤£¨ì¦Û¤vªº¯ÊÂI¡C
ªð¦^¦Cªí ¤W¤@¥DÃD