Andy2483

¦^´_ 1# 198188


    ½Ð«e½ú¤W¶Ç½d¨ÒÀÉ

Andy2483

¦^´_ 3# 198188


    ÁÂÁ«e½úµoªí¦¹¥DÃD»P½d¨Ò,«á¾Ç¾Ç²ß¤è®×¦p¤U,½Ð«e½ú°Ñ¦Ò

Option Explicit
Sub TEST()
Dim Brr, Z, K, i&, j%, N&
Set Z = CreateObject("Scripting.Dictionary")
Brr = [Read!A1].CurrentRegion
For i = 2 To UBound(Brr): Z(Brr(i, 1)) = Val(Brr(i, 3)): Next
Brr = Range([Data!A1], [Data!A1].CurrentRegion.Offset(UBound(Brr)))
For i = 2 To UBound(Brr)
   If Z.Exists(Brr(i, 8)) Then
      Z(Brr(i, 1) & "/") = i
      Brr(i, 3) = Z(Brr(i, 8)) & "*" & Val(Brr(i, 3))
   End If
   If Z.Exists(Brr(i, 8) & "/") Then
      Z(Brr(i, 8) & "//") = i
      Brr(i, 3) = Brr(Z(Brr(i, 8) & "/"), 3) & "*" & Val(Brr(i, 3))
   End If
Next
For Each K In Z.Keys
   If InStr(K, "/") Then
      N = N + 1
      For j = 1 To UBound(Brr, 2): Brr(N, j) = Brr(Z(K), j): Next
      'Brr(N, 3) = "=" & Brr(N, 3)
   End If
Next
Workbooks.Add
[A1].Resize(N, UBound(Brr, 2)) = Brr
End Sub

Andy2483

Brr = Range([Data!A1], [Data!A1].CurrentRegion.Offset(UBound(Brr)))

½Ð°Ý«e½ú¡A³o¥y¦pªG·Q§ï
x ...
198188 µoªí©ó 2025-11-6 15:12

With Workbooks("Data Base.xlsx").Sheets("Data")
   Brr = .Range(.[A1], .[A1].CurrentRegion.Offset(UBound(Brr)))
End With

Andy2483

¦^´_ 9# 198188


    ½Ð«e½ú¦Û¦æ¸Õ¸Õ¼g¤@¬q¥N½X¥ý§âData ¦P¸¹¬Û¥[¡A¦A±NRead¤ñ¹ï2¦¸Data

Andy2483

¦^´_ 9# 198188


    ³o¦nÃø,¤£ª¾¹D¹ï¤£¹ï,½Ð«e½ú«ü±Ð

°õ¦æµ²ªG:

¤U¸ü (73.55 KB)

¬Q¤Ñ 16:37

Option Explicit
Sub TEST1()
Dim brr, X, Y, Z, K, Q, i&, j%, n&, T1$, T8$
Set Z = CreateObject("Scripting.Dictionary")
Set Y = CreateObject("Scripting.Dictionary")
Set X = CreateObject("Scripting.Dictionary")
brr = Sheets(1).[A1].CurrentRegion
For i = 2 To UBound(brr)
   If Y(brr(i, 1)) = "" Then
      Y(brr(i, 1)) = "(" & Val(brr(i, 3))
      Else
      Y(brr(i, 1)) = Y(brr(i, 1)) & "+" & Val(brr(i, 3))
   End If
Next
brr = Sheets(2).[A1].CurrentRegion
For i = 2 To UBound(brr)
   T1 = brr(i, 1)
   T8 = brr(i, 8)
   If Y.Exists(T8) Then
      If Not IsObject(Z(T8 & "/")) Then
         Set Z(T8 & "/") = CreateObject("Scripting.Dictionary")
         brr(i, 3) = Y(T8) & ")*(" & Val(brr(i, 3))
         Z(T1) = brr(i, 3)
         Else
         Z(T1) = Z(T8) & "+" & Val(brr(i, 3))
         brr(i, 3) = Y(T8) & ")*(" & Val(brr(i, 3))
      End If
      Z(T8 & "/")(i) = ""
      Z(T8) = brr(i, 3)
   End If
Next
For i = 2 To UBound(brr)
   T1 = brr(i, 1)
   T8 = brr(i, 8)
   If Z.Exists(T8) And Not Y.Exists(T8) Then
      If Not IsObject(Z(T8 & "/")) Then
         Set Z(T8 & "/") = CreateObject("Scripting.Dictionary")
         brr(i, 3) = Z(T8) & ")*(" & Val(brr(i, 3))
         X(T1) = brr(i, 3)
         Else
         X(T1) = X(T8) & "+" & Val(brr(i, 3))
         brr(i, 3) = Z(T8) & ")*(" & Val(brr(i, 3))
      End If
      Z(T8 & "/")(i) = ""
      X(T8) = brr(i, 3)
   End If
Next
For Each K In Z.Keys
   If IsObject(Z(K)) Then
      For Each Q In Z(K).Keys
         n = n + 1
         For j = 1 To UBound(brr, 2): brr(n, j) = brr(Q, j): Next
         brr(n, 3) = brr(n, 3) & ")": 'Brr(N, 3) = "=" & Brr(N, 3)
      Next
   End If
Next
If n > 0 Then Workbooks.Add: [A1].Resize(n, UBound(brr, 2)) = brr
End Sub

Andy2483

¦^´_ 14# 198188


    ÁÂÁ«e½ú«ü¾É,«Ü¦h¨S¬Ý¹Lªº,«á¾Ç°õ¦æ¥X²{°»¿ù,½Ð«e½ú«üÂI

¤U¸ü (98.97 KB)

¬Q¤Ñ 16:40