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

[µo°Ý] ½Ð°Ý¦p¦ó¨ÌÃþ§O¤ÀÃþ¨Ã¨Ì§Ç¶K¤W¤£­«½Æ­È

[µo°Ý] ½Ð°Ý¦p¦ó¨ÌÃþ§O¤ÀÃþ¨Ã¨Ì§Ç¶K¤W¤£­«½Æ­È

¨ÌÃþ§O¤ÀÃþ¨Ã¨Ì§Ç¶K¤W¤£­«½Æ­È.zip (29.58 KB)

³B²z«e                                               ³B²z«á

¦^´_ 1# starry1314


    ³B²z«áªºªí®æªºAÄæ¬O©T©w¦WºÙ,­nÅýBÄæ¨ÌAÄ檺Ãþ§O¦WºÙ¦Û°Ê§ì¨ú¤u§@ªí1ªº«~¦W,¥B¤£­«½Æ­È

TOP

=IFERROR(INDEX(¤u§@ªí1!F:F,SMALL(IF((¤u§@ªí1!E$2:E$51=LOOKUP(1,0/(A$1:A1<>""),A$1:A1))*(MATCH(¤u§@ªí1!F$2:F$51,¤u§@ªí1!F$2:F$51,)=ROW(E$2:E$51)-1),ROW(E$2:E$51)),ROW(A1)+1-LOOKUP(1,0/(A$1:A1<>""),ROW(A$1:A1)))),"")

TOP

http://blog.xuite.net/hcm19522/twblog/353777556

TOP

ÁÂÁ½׾Â,ÁÂÁ¦U¦ì«e½ú
«á¾ÇÂǦ¹©«½m²ßVBA°}¦C»P¦r¨å,¾Ç²ß¤è®×¦p¤U,½Ð¦U¦ì«e½ú«ü±Ð

¸ê®Æªí:


µ²ªGªí°õ¦æ«e:


°õ¦æµ²ªG:



Option Explicit
Sub TEST() '¡ô
Dim Brr, Crr, V, Z, Q, P, i&, T$
Set Z = CreateObject("Scripting.Dictionary")
Brr = Intersect(Sheets("®æ¦¡").UsedRange, [®æ¦¡!A:A])
ReDim Crr(1 To UBound(Brr), 1 To 2)
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): If T = "" Then GoTo i01
   If InStr(T, "¶¼«~") = 1 Then Brr(i, 2) = T: T = "¶¼«~"
   V = Z(T): If V = "" Then GoTo i01
   Q = Z(T & "|" & Brr(i, 2)): P = Z(T & "|")
   If Val(Q) = 0 Then
      Crr(V + P, 1) = Brr(i, 2)
      Crr(V + P, 2) = Brr(i, 3)
      Z(T & "|" & Brr(i, 2)) = V + P
      Z(T & "|") = P + 1
      GoTo i01
   End If
   Crr(Q, 2) = Crr(Q, 2) + Brr(i, 3)
i01: Next
[®æ¦¡!B1].Resize(UBound(Crr), 2) = Crr
Set Z = Nothing: Erase Brr, Crr
End Sub
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

ÁÂÁ½׾Â,ÁÂÁ¦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
¥Î¦æ°Ê¸Ë¸mÂsÄý½×¾Â¾Ç²ß«Ü¤è«K,ÁÂÁ½׾¸gÀç¹Î¶¤
½Ð¤j®a¤@°_¤W½×¾Â¨Ó¥æ¬y

TOP

        ÀR«ä¦Û¦b : ¹ï¤÷¥À­nª¾®¦¡A·P®¦¡B³ø®¦¡C
ªð¦^¦Cªí ¤W¤@¥DÃD