[µo°Ý] ¨âªí¸ê®Æ­«½Æ¹ï¤ñ¨Ã¼Æ¶q¬Û­¼

198188

¤U¸ü (166.95 KB)

2025-11-6 09:39

¦³¨â­Óªí Read & Data

Data ¬O¸ê®ÆÀÉ®×
Read ¬Oµ{¦¡°õ¦æÀÉ®×


°õ¦æµ{¦¡³W«h¡G
Read ªí ¦Ç¦â³¡¤À¬O­ì¦³¸ê®Æ¡A«O¯d¡C
Read ªí A Äæ  ¹ï¤ñ Data ªí H Äæ¡A
­Y§k¦X¡A½Æ»s Data ªí ¹ïÀ³ªº¤@¦C¸ê®Æ¨ì Read ªí A Äæ³Ì«á¤@¦C«á, ¼Æ¶q Read ªí  Qty * Data ªí Qty ¡]¦pÂŦⳡ¤À¡^
§¹¦¨«á¡A¦A­«½Æ¤@¦¸
Read ªí A Äæ  ¹ï¤ñ Data ªí H Äæ¡A
­Y§k¦X¡A½Æ»s Data ªí ¹ïÀ³ªº¤@¦C¸ê®Æ¨ì Read ªí A Äæ³Ì«á¤@¦C«á, ¼Æ¶q Read ªí  Qty * Data ªí Qty ¡]¦pºñ¦â¦â³¡¤À¡^

198188

¦^´_ 24# ­ã´£³¡ªL


    «e½ú§A¦n¡A½Ð°Ý¦pªG¥H³o­Ó´`Àô°µ2¦¸ªº¼Ò¦¡¡AÀ³¸Ó¦p¦ó­×§ï´`Àô°µ5¦¸¡C

­ã´£³¡ªL

¦^´_ 9# 198188

Sub Test()
Dim Arr, Brr, Crr, xD, T$, V, i&, j%, k%, U&, N&
Set xD = CreateObject("Scripting.Dictionary")
Arr = Range(Sheets("Read").[m1], Sheets("Read").[a65536].End(3))
Brr = Range(Sheets("Data Base").[m1], Sheets("Data Base").[a65536].End(3))
'----------------------------------
ReDim Crr(1 To UBound(Brr), 1 To UBound(Brr, 2))
N = 2: Crr(N, 1) = "'==( Round-" & k + 1 & " )======"
For j = 1 To UBound(Arr, 2): Crr(N - 1, j) = Arr(1, j): Next
'-----------------------------------
For i = 2 To UBound(Arr)
    T = Arr(i, 1): V = Val(Arr(i, 3)): U = xD(T & "+" & k)
    If U = 0 Then
       N = N + 1: U = N: xD(T & "+" & k) = N: V = 0
       For j = 1 To UBound(Arr, 2): Crr(N, j) = Arr(i, j): Next
    End If
    Crr(U, 3) = Crr(U, 3) + V
    xD(T & "/" & k) = Crr(U, 3)
Next i
'------------------------------
For k = 1 To 2
    N = N + 1: Crr(N, 1) = "'==( Round-" & k + 1 & " )======"
    For i = 2 To UBound(Brr)
        T = Brr(i, 8): V = Val(Brr(i, 3)): U = xD(T & "/" & k - 1)
        If U > 0 Then
           N = N + 1: T = Brr(i, 1)
           For j = 1 To UBound(Brr, 2): Crr(N, j) = Brr(i, j): Next
           Crr(N, 3) = V * U
           xD(T & "/" & k) = xD(T & "/" & k) + V * U
        End If
    Next i
Next k
'------------------------------
With Sheets("Test")
     .UsedRange.EntireRow.Delete
     .[a1].Resize(N, UBound(Crr, 2)) = Crr
     Application.Goto .[a1]
End With
Beep
End Sub

Xl0000322.rar (22.32 KB)

¤U¸ü¦¸¼Æ: 5

2025-12-6 13:43

198188

¦^´_  198188


Crr(N, 3) = Crr(N, 3) = Evaluate(Crr(N, 3) & ")")
§ï¬°
Crr(N, 3) = Evaluate(Cr ...
Andy2483 µoªí©ó 2025-11-11 10:14

ÁÂÁ«e½ú«üÂI¡C

Andy2483

¦^´_ 21# 198188


Crr(N, 3) = Crr(N, 3) = Evaluate(Crr(N, 3) & ")")
§ï¬°
Crr(N, 3) = Evaluate(Crr(N, 3) & ")")
¸Õ¸Õ¬Ý

198188

¦^´_  198188


   
±N18¼Ó¤è®× Crr(N, 3) = Crr(N, 3) & ")": Crr(N, 5) = "=" & Crr(N, 3)
§ï¦¨   ...
Andy2483 µoªí©ó 2025-11-11 09:13

1. Option Explicit
   
2. Sub TEST11()
   
3. Const Ref = 2
   
4. Dim Brr, Crr, Y, Z(0 To Ref + 1), K, i&, j%, N&, T1$, T8$, d%
   
5. Set Y = CreateObject("Scripting.Dictionary")
   
6. For i = 0 To Ref + 1: Set Z(i) = CreateObject("Scripting.Dictionary"): Next
   
7. Brr = Sheets(1).[A1].CurrentRegion
   
8. For i = 2 To UBound(Brr)
   
9.    If Z(1)(Brr(i, 1)) = "" Then
   
10.       Z(1)(Brr(i, 1)) = "(" & Val(Brr(i, 3))
    
11.       Else
    
12.       Z(1)(Brr(i, 1)) = Z(1)(Brr(i, 1)) & "+" & Val(Brr(i, 3))
    
13.    End If
    
14. Next
    
15. Brr = Sheets(2).[A1].CurrentRegion
    
16. For d = 2 To Ref + 1
    
17.    For i = 2 To UBound(Brr)
    
18.       T1 = Brr(i, 1)
    
19.       T8 = Brr(i, 8)
    
20.       If Y.Exists(i) Then GoTo i01
    
21.       If Z(d - 1).Exists(T8) And Z(d - 1)(T8 & "/") = "" And Not Z(d - 2).Exists(T8) Then
    
22.          Brr(i, 3) = Z(d - 1)(T8) & ")*(" & Val(Brr(i, 3))
    
23.          Z(d)(T1) = Brr(i, 3)
    
24.          Z(d - 1)(T8 & "/") = Brr(i, 3)
    
25.          Y(i) = ""
    
26.          Z(d)(T8) = Brr(i, 3)
    
27.          ElseIf Z(d - 1)(T8 & "/") <> "" Then
    
28.             Z(d)(T1) = Z(d)(T8) & "+" & Val(Brr(i, 3))
    
29.             Brr(i, 3) = Z(d - 1)(T8) & ")*(" & Val(Brr(i, 3))
    
30.             Y(i) = ""
    
31.             Z(d)(T8) = Brr(i, 3)
    
32.       End If
    
33. i01: Next
    
34. Next
    
35. ReDim Crr(1 To Y.Count, 1 To UBound(Brr, 2))
    
36. For Each K In Y.Keys
    
37.    N = N + 1
    
38.    For j = 1 To UBound(Brr, 2): Crr(N, j) = Brr(K, j): Next
    
39.    Crr(N, 3) = Crr(N, 3) = Evaluate(Crr(N, 3) & ")")
    
40. Next
    
41. If N > 0 Then Workbooks.Add: [A1].Resize(N, UBound(Brr, 2)) = Crr
    
42. End Sub

½Æ»s¥N½X

«e½ú¡A§ï§¹¥X²{ªºQty ¬O " FALSE "

Andy2483

¦^´_ 19# 198188


    https://learn.microsoft.com/zh-t ... pplication.evaluate
±N18¼Ó¤è®× Crr(N, 3) = Crr(N, 3) & ")": Crr(N, 5) = "=" & Crr(N, 3)
§ï¦¨              Crr(N, 3) = Evaluate(Crr(N, 3) & ")")

¥H¤W¬O¥i¥Hª½±µ±o¨ì¼Æ­Èªº¤èªk»PEvaluate() °Ñ¦Òºô­¶
PS:«á¾ÇÅÞ¿è/¤ßºâ³£´¶´¶,¨S¦³¥Î18¼Ó«÷´ê¥X¤½¦¡ªº¤èªk,¸£µ¬·|¥´µ²
ÁÂÁ«e½ú«ü±Ð

198188

¦^´_  Andy2483


    ¤µ¤Ñ¾Ç²ß¥i¦h½ü­pºâ¤è®×,½Ð¦U¦ì«e½ú«ü±Ð

Option Explicit
Sub TEST2()
Cons ...
Andy2483 µoªí©ó 2025-11-10 16:45

1. Option Explicit
   
2. Sub TEST2()
   
3. Const Ref = 2
   
4. Dim Brr, Crr, Y, Z(0 To Ref + 1), K, i&, j%, N&, T1$, T8$, d%
   
5. Set Y = CreateObject("Scripting.Dictionary")
   
6. For i = 0 To Ref + 1: Set Z(i) = CreateObject("Scripting.Dictionary"): Next
   
7. Brr = Sheets(1).[A1].CurrentRegion
   
8. For i = 2 To UBound(Brr)
   
9.    If Z(1)(Brr(i, 1)) = "" Then
   
10.       Z(1)(Brr(i, 1)) = Val(Brr(i, 3))
    
11.       Else
    
12.       Z(1)(Brr(i, 1)) = Z(1)(Brr(i, 1)) + Val(Brr(i, 3))
    
13.    End If
    
14. Next
    
15. Brr = Sheets(2).[A1].CurrentRegion
    
16. For d = 2 To Ref + 1
    
17.    For i = 2 To UBound(Brr)
    
18.       T1 = Brr(i, 1)
    
19.       T8 = Brr(i, 8)
    
20.       If Y.Exists(i) Then GoTo i01
    
21.       If Z(d - 1).Exists(T8) And Z(d - 1)(T8 & "/") = "" And Not Z(d - 2).Exists(T8) Then
    
22.          Brr(i, 3) = Z(d - 1)(T8) * Val(Brr(i, 3))
    
23.          Z(d)(T1) = Brr(i, 3)
    
24.          Z(d - 1)(T8 & "/") = Brr(i, 3)
    
25.          Y(i) = ""
    
26.          Z(d)(T8) = Brr(i, 3)
    
27.          ElseIf Z(d - 1)(T8 & "/") <> "" Then
    
28.             Z(d)(T1) = Z(d)(T8) + Val(Brr(i, 3))
    
29.             Brr(i, 3) = Z(d - 1)(T8) * Val(Brr(i, 3))
    
30.             Y(i) = ""
    
31.             Z(d)(T8) = Brr(i, 3)
    
32.       End If
    
33. i01: Next
    
34. Next
    
35. ReDim Crr(1 To Y.Count, 1 To UBound(Brr, 2))
    
36. For Each K In Y.Keys
    
37.    N = N + 1
    
38.    For j = 1 To UBound(Brr, 2): Crr(N, j) = Brr(K, j): Next
    
39.    Crr(N, 3) = Crr(N, 3): Crr(N, 5) = Crr(N, 3)
    
40. Next
    
41. If N > 0 Then Workbooks.Add: [A1].Resize(N, UBound(Brr, 2)) = Crr
    
42. End Sub

½Æ»s¥N½X

ÁÂÁ«e½ú«üÂI¡A½Ð°Ý¦pªGª½±µ­pºâQty, §Ú§R°£¤F¤@¨Ç¡§¡]¡^+ * ¡¨¡A¦ý¬O²Ä¤G½üªºª÷ÃB¤£¹ï¡A¬O§_§Ú§R±o¤£¹ï¡A½ÐÀ°¬Ý¬Ý¡C

Andy2483

¦^´_ 15# Andy2483


    ¤µ¤Ñ¾Ç²ß¥i¦h½ü­pºâ¤è®×,½Ð¦U¦ì«e½ú«ü±Ð

Option Explicit
Sub TEST2()
Const Ref = 2
Dim Brr, Crr, Y, Z(0 To Ref + 1), K, i&, j%, N&, T1$, T8$, d%
Set Y = CreateObject("Scripting.Dictionary")
For i = 0 To Ref + 1: Set Z(i) = CreateObject("Scripting.Dictionary"): Next
Brr = Sheets(1).[A1].CurrentRegion
For i = 2 To UBound(Brr)
   If Z(1)(Brr(i, 1)) = "" Then
      Z(1)(Brr(i, 1)) = "(" & Val(Brr(i, 3))
      Else
      Z(1)(Brr(i, 1)) = Z(1)(Brr(i, 1)) & "+" & Val(Brr(i, 3))
   End If
Next
Brr = Sheets(2).[A1].CurrentRegion
For d = 2 To Ref + 1
   For i = 2 To UBound(Brr)
      T1 = Brr(i, 1)
      T8 = Brr(i, 8)
      If Y.Exists(i) Then GoTo i01
      If Z(d - 1).Exists(T8) And Z(d - 1)(T8 & "/") = "" And Not Z(d - 2).Exists(T8) Then
         Brr(i, 3) = Z(d - 1)(T8) & ")*(" & Val(Brr(i, 3))
         Z(d)(T1) = Brr(i, 3)
         Z(d - 1)(T8 & "/") = Brr(i, 3)
         Y(i) = ""
         Z(d)(T8) = Brr(i, 3)
         ElseIf Z(d - 1)(T8 & "/") <> "" Then
            Z(d)(T1) = Z(d)(T8) & "+" & Val(Brr(i, 3))
            Brr(i, 3) = Z(d - 1)(T8) & ")*(" & Val(Brr(i, 3))
            Y(i) = ""
            Z(d)(T8) = Brr(i, 3)
      End If
i01: Next
Next
ReDim Crr(1 To Y.Count, 1 To UBound(Brr, 2))
For Each K In Y.Keys
   N = N + 1
   For j = 1 To UBound(Brr, 2): Crr(N, j) = Brr(K, j): Next
   Crr(N, 3) = Crr(N, 3) & ")": Crr(N, 5) = "=" & Crr(N, 3)
Next
If N > 0 Then Workbooks.Add: [A1].Resize(N, UBound(Brr, 2)) = Crr
End Sub

198188

¦^´_  198188


    ÁÂÁ«e½ú«ü¾É,«Ü¦h¨S¬Ý¹Lªº,«á¾Ç°õ¦æ¥X²{°»¿ù,½Ð«e½ú«üÂI
Andy2483 µoªí©ó 2025-11-7 16:40

   

¤U¸ü (51.12 KB)

2025-11-7 17:39

«e½ú¡A»Ý­n¥h ¤u¨ã =>³]©w¤Þ¥Î¶µ¥Ø => Microsoft Scripting Runtime
ªþ¤W½d¨Ò