luhpro

¤p§Ì§Ú³Ìªñ¦b¾ã²z¸ê®Æ¹J¨ì­n±N¸ê®ÆÂà´«¬°¾î¦C
µM«á­n±N«ü©w¯Å¶Z¤ºªº¸ê®Æ©ñ¤J¡A§Ú¸Ó¦p¦ó¼g¨ç¼Æ©O?
ex. ...
dragonbx µoªí©ó 2014-9-19 11:25

1. Sub nn()
   
2.   Dim iCol%
   
3.   Dim lRow&
   
4.   Dim vD
   
5.   Dim rTar As Range
   
6.   
   
7.   Set vD = CreateObject("Scripting.Dictionary")
   
8.   lRow = 2
   
9.   Do While Cells(lRow, 1) <> ""
   
10.     With Cells(lRow, 1)
    
11.       If Not vD.Exists(.Text) Then
    
12.         vD(.Text) = .Offset(, 1)
    
13.       Else
    
14.         vD(.Text) = vD(.Text) & "," & .Offset(, 1)
    
15.       End If
    
16.     End With
    
17.     lRow = lRow + 1
    
18.   Loop
    
19.   
    
20.   iCol = 5
    
21.   Do While Cells(1, iCol) <> ""
    
22.     With Cells(2, iCol + 1)
    
23.       Range(.Offset(, -1), .Offset(20, 26)).Clear
    
24.       .Value = vD(.Offset(-1, -1).Text)
    
25.       If .Value <> "" Then
    
26.         .TextToColumns Comma:=True
    
27.         Set rTar = Range(.Offset(0), .Offset(, .Offset(0).End(xlToRight).Column - .Column))
    
28.         rTar.Copy
    
29.         .Offset(, -1).PasteSpecial Transpose:=True
    
30.         rTar.Clear
    
31.       End If
    
32.     End With
    
33.     iCol = iCol + 1
    
34.   Loop
    
35. End Sub

½Æ»s¥N½X

¸ê®ÆÂà´«°ÝÃD-a.zip (7.77 KB)

¤U¸ü¦¸¼Æ: 2

2014-9-20 11:57