ÂkÃþ¦X¨Ö

198188

¸ê®Æ®w(VBA«e)
¤ÀÃþ        ÃC¦â
¤ôªG        ¬õ
¤ôªG        ¬õ
¤ôªG        ºñ
¤ôªG        ºñ
½­µæ        ºñ
½­µæ        ºñ
½­µæ        ¬õ
½­µæ        ¬õ
½­µæ        ºñ

Sub Combine()
   Dim i As Integer, j As Integer, k As Integer
   Dim rowC As Integer
   Dim rB As Range
   Dim data() As String
   Dim found As Boolean

   '¥ý±N O:Z ªº¸ê®Æ²M°£
   Sheets(1).Range("O:Z").ClearContents

   '­pºâ¦h¤Öµ§¸ê®Æ­n³B²z
   rowC = Sheets(1).Range("A1").CurrentRegion.Rows.Count
   '¥ý¼È¦s¸ê®Æ¡A¥[³t³B²z
   Set rB = Sheets(1).Range(Cells(1, 1), Cells(rowC, 14))
   ReDim data(rowC, 14)

   k = 0
   For i = 1 To rowC '³B²z¸ê®Æ
       j = 1
       found = False
       While (j <= k) And (found = False) '¤ñ¹ï¦³¨S¦³¥X²{¹L
          If rB(i, 3) = data(j, 3) Then
             found = True
             data(j, 4) = data(j, 4) + "¡B" + rB(i, 4)
             data(j, 5) = data(j, 5) + "¡B" + rB(i, 5)
             data(j, 6) = data(j, 6) + "¡B" + rB(i, 6)
             data(j, 7) = data(j, 7) + "¡B" + rB(i, 7)
             data(j, 8) = data(j, 8) + "¡B" + rB(i, 8)
             data(j, 9) = data(j, 9) + "¡B" + rB(i, 9)
             data(j, 10) = data(j, 10) + "¡B" + rB(i, 10)
             data(j, 11) = data(j, 11) + "¡B" + rB(i, 11)
             data(j, 12) = data(j, 12) + "¡B" + rB(i, 12)
             data(j, 13) = data(j, 13) + "¡B" + rB(i, 13)
             data(j, 14) = data(j, 14) + "¡B" + rB(i, 14)
          End If
          j = j + 1
       Wend

       If found = False Then  '¨S¦³¥X²{¹L¥[¤J·s¸ê®Æ
          k = k + 1
          data(k, 3) = rB(i, 3)
          data(k, 4) = rB(i, 4)
          data(k, 5) = rB(i, 5)
          data(k, 6) = rB(i, 6)
          data(k, 7) = rB(i, 7)
          data(k, 8) = rB(i, 8)
          data(k, 9) = rB(i, 9)
          data(k, 10) = rB(i, 10)
          data(k, 11) = rB(i, 11)
          data(k, 12) = rB(i, 12)
          data(k, 13) = rB(i, 13)
          data(k, 14) = rB(i, 14)
       End If
   Next i

   For i = 1 To k '¦C¦L¸ê®Æ
       Cells(i, 15) = data(i, 3)
       Cells(i, 16) = data(i, 4)
       Cells(i, 17) = data(i, 5)
       Cells(i, 18) = data(i, 6)
       Cells(i, 19) = data(i, 7)
       Cells(i, 20) = data(i, 8)
       Cells(i, 21) = data(i, 9)
       Cells(i, 22) = data(i, 10)
       Cells(i, 23) = data(i, 11)
       Cells(i, 24) = data(i, 12)
       Cells(i, 25) = data(i, 13)
       Cells(i, 26) = data(i, 14)
    Next i
   MsgBox ("Sucess")
End Sub


VBA«á
¤ÀÃþ        ÃC¦â
¤ôªG        ¬õ¡B¬õ¡Bºñ¡Bºñ
½­µæ        ºñ¡Bºñ¡B¬õ¡B¬õ¡Bºñ

198188

ar = Range("A1").CurrentRegion.Value    ³o¥y¬O§_­pºâAÄ榳´X¦h¦C¦³¸ê®Æ¡H

Set dic = CreateObject("Scripting.Dictionary")   ³o¥y¤£©ú¥Õ

For i = 1 To UBound(ar, 1)      UBound¬O¤°»ò¥Î³~¡H

dic(ar(i, 1)) = IIf(dic(ar(i, 1)) = "", ar(i, 2), dic(ar(i, 1)) & "¡B" & ar(i, 2))    dic¤Îar¬O¤°»ò·N«ä?

Next

C] = ""
[C1].Resize(dic.Count, 1) = Application.Transpose(dic.keys)     resize¤ÎApplication.Transpose¬O¤°»ò·N«ä
¦p¦ó¥Îªk¡H¥i¥H¸ÑÄÀ¤@¤U¡H

Hsieh

¦^´_ 1# 198188
©pªºµ{¦¡½X»P½d¨Ò»¡©ú¨Ã¤£¤@¼Ë
­Y¸ê®Æ¦bA:BÄæ¡A°õ¦æ«á±N¸ê®Æ©ñ¦bC:DÄæ¡A¸Õ¸Õ¥H¤U¥N½X

1. Sub ex()
   
2. ar = Range("A1").CurrentRegion.Value
   
3. Set dic = CreateObject("Scripting.Dictionary")
   
4. For i = 1 To UBound(ar, 1)
   
5. dic(ar(i, 1)) = IIf(dic(ar(i, 1)) = "", ar(i, 2), dic(ar(i, 1)) & "¡B" & ar(i, 2))
   
6. Next
   
7. [C:D] = ""
   
8. [C1].Resize(dic.Count, 1) = Application.Transpose(dic.keys)
   
9. [D1].Resize(dic.Count, 1) = Application.Transpose(dic.items)
   
10. End Sub

½Æ»s¥N½X