GBKEE

¦^´_ 4# lone_tiger0303

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim I As Integer, C, AR()
   
4.     ReDim AR(1, 0)
   
5.     With Sheet1
   
6.         For I = 1 To .[A3].End(xlToRight).Column
   
7.             For Each C In .Range(.Cells(4, I), .Cells(Rows.Count, I).End(xlUp))
   
8.                 If C <> "" And C.Row > 3 Then
   
9.                     AR(0, UBound(AR, 2)) = C
   
10.                     AR(1, UBound(AR, 2)) = .Cells(3, I)
    
11.                     ReDim Preserve AR(1, UBound(AR, 2) + 1)
    
12.                 End If
    
13.             Next
    
14.         Next
    
15.     End With
    
16.     With Sheet2
    
17.         .Range(.[A3], .[B3].End(xlDown)) = ""
    
18.         .[A3].Resize(UBound(AR, 2), 2) = Application.WorksheetFunction.Transpose(AR)
    
19.     End With
    
20. End Sub

½Æ»s¥N½X

GBKEE

¦^´_ 7# lone_tiger0303
¨S¦³¬G»Ùªü!
½Ð¬Ý²M°£¦p¹Ï:  «ü©w¦n¥¿½Tªº¤u§@ªíª«¥ó¦WºÙ

¤U¸ü (44.13 KB)

2011-3-4 13:17