[µo°Ý] ¦p¦ó±Æ¥X±a¦³¤å¦r©M¼Æ¦r¸ê®Æ

luke

¤p§Ì¸I¨ì¤A­Ó±a¦³¤å¦r©M¼Æ¦r°ÝÃD, ¦]¸ê®Æ±`±`§@Åܧó, §Ú·Q¥ÎVBA¨Ì§Ç±Æ¥X, ©ñ¤JSheet2¤¤

³Â·Ð½Ð±Ð¥ý¶i!!
TEST1.rar (21.9 KB)

¤U¸ü¦¸¼Æ: 15

2012-3-29 22:45

chin15

1. Option Explicit
   
2. Sub test()
   
3.     Dim n%, c%, i%, j%, m%, arr(), rng
   
4.     n = [a65536].End(3).Row
   
5.     c = [iv1].End(1).Column
   
6.     rng = [a1].Resize(n, c)
   
7.     For i = 2 To c
   
8.         For j = 2 To n
   
9.             If rng(j, i) <> "" Then
   
10.                 m = m + 1
    
11.                 ReDim Preserve arr(1 To 3, 1 To m)
    
12.                 arr(1, m) = rng(1, i)
    
13.                 arr(2, m) = rng(j, 1)
    
14.                 arr(3, m) = rng(j, i)
    
15.             End If
    
16.         Next
    
17.     Next
    
18.     Sheet2.[a1].Resize(m, 3) = Application.Transpose(arr)
    
19. End Sub

½Æ»s¥N½X

Hsieh

1. Sub ex()
   
2. Dim Ay()
   
3. ar = Range("A1").CurrentRegion
   
4. For i = 2 To UBound(ar, 2)
   
5.    For j = 2 To UBound(ar, 1)
   
6.       If ar(j, i) <> "" Then
   
7.          ReDim Preserve Ay(s)
   
8.          Ay(s) = Array(ar(1, i), ar(j, 1), ar(j, i))
   
9.          s = s + 1
   
10.       End If
    
11.     Next
    
12. Next
    
13. [S1].Resize(s, 3) = Application.Transpose(Application.Transpose(Ay))
    
14. End Sub

½Æ»s¥N½X

¦^´_ 1# luke