- ©«¤l
- 1446
- ¥DÃD
- 40
- ºëµØ
- 0
- ¿n¤À
- 1470
- ÂI¦W
- 0
- §@·~¨t²Î
- Windows 7
- ³nÅ骩¥»
- Excel 2010 & 2016
- ¾\ŪÅv
- 50
- ©Ê§O
- ¨k
- ¨Ó¦Û
- ¥xÆW
- µù¥U®É¶¡
- 2020-7-15
- ³Ì«áµn¿ý
- 2024-10-21
|
ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«©µ¦ù¾Ç²ß,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð
¸ê®Æªí¤º®eקï«á:
°õ¦æµ²ªG:
Option Explicit
Sub TEST_1()
Dim Brr, Crr, V, Z, Q, P, i&, T$, T2$, T4$
Set Z = CreateObject("Scripting.Dictionary")
Brr = Intersect(Sheets("®æ¦¡").UsedRange, [®æ¦¡!A:A])
ReDim Crr(1 To UBound(Brr), 1 To 3)
For i = 1 To UBound(Brr)
If Brr(i, 1) <> "" Then Z(Brr(i, 1)) = i
Next
Brr = Range([¤u§@ªí1!H2], [¤u§@ªí1!E65536].End(3))
For i = 1 To UBound(Brr)
T = Brr(i, 1): T2 = Brr(i, 2): T4 = Brr(i, 4)
If T = "" Then GoTo i01
If InStr(T, "¶¼«~") = 1 Then T2 = T: T = "¶¼«~"
V = Z(T): If V = "" Then GoTo i01
Q = Z(T & "|" & T2): P = Z(T & "|")
If Val(Q) = 0 Then
Crr(V + P, 1) = T2
Crr(V + P, 2) = Brr(i, 3)
Z(T & "|" & T2) = V + P
Z(T & "|") = P + 1
GoTo i01
End If
Crr(Q, 2) = Crr(Q, 2) + Brr(i, 3)
i01: If T4 <> "" Then T = T4 & "|/" & T & "|" & T2: Z(T) = Z(T) + 1
Next
For Each V In Z.KEYS
If InStr(V, "|/") = 0 Then GoTo v01
P = Split(V, "|/")(0)
Q = Split(V, "|/")(1)
If Crr(Z(Q), 3) = "" Then
Crr(Z(Q), 3) = P & "X" & Z(V)
Else
Crr(Z(Q), 3) = Crr(Z(Q), 3) & "; " & P & "X" & Z(V)
End If
v01: Next
[®æ¦¡!B1].Resize(UBound(Crr), 3) = Crr
Set Z = Nothing: Erase Brr, Crr
End Sub |
|