[µo°Ý] ¸ê®ÆÂà¸mªº¤p°ÝÃD

boblovejoyce

¤U¸ü (27.29 KB)

2015-6-22 16:15

³o­ÓÂà¸mªº¤è¦¡,§Úª¦¤åª¦ª¦§ä¤£¨ìÃþ¦üªº¤è¦¡
¥i¬O¤Sı±oÀ³¸Ó¬O«Ü²³æ~Ãþ¦ü¤å³¹À³¸Ó¦³Ãþ¦üªº

¦b¬Y­Ó¤å³¹¦³¬Ý¨ì¤U­±ªº¥N½X:
Sub test()
    Dim arr
    arr = Range("a1:c3")
    Range("f1").Resize(UBound(arr, 2), UBound(arr)) = Application.WorksheetFunction.Transpose(arr)
End Sub

«Ü²³æªº´NÂà¸m¤F~
¥i¬O¥L¬O¾ã­Ó¸ê®Æ½d³òÂà¸m

¦ý§Ú¥u·Q­n¦p¹Ï¥Üªº,Âà¸m«á¸ê®ÆÅܦ¨¨âÄ椤´N¦n
Àµ½Ð¤j¤j­Ì «üÂI¤@¤G

lpk187

¦^´_ 1# boblovejoyce

¸Õ¸Õ¬Ý§a¡I

1. Sub test()
   
2. Dim arr1()
   
3. en = Cells(Rows.Count, 1).End(xlUp).Row
   
4. arr = Range("b2:c" & en)
   
5. x = 1
   
6. j = 1
   
7. For Each Rng In Range("a2:a" & en)
   
8.     i = 1
   
9.     For Each rng1 In [b1:c1]
   
10.         ReDim Preserve arr1(1 To 2, 1 To x)
    
11.         arr1(1, x) = Rng & rng1
    
12.         arr1(2, x) = arr(j, i)
    
13.         x = x + 1: i = i + 1
    
14.     Next
    
15.     j = j + 1
    
16. Next
    
17. [F1].Resize(UBound(arr1, 2), 2) = Application.Transpose(arr1)
    
18. End Sub

½Æ»s¥N½X

boblovejoyce

¦^´_ 2# lpk187


    :loveliness:
¥i¥H¨Ï¥Î~~¯«¨Ó¤@¸Ñ~~
¨C¦¸³£¬O¤j¤j¸Ñ´b¤§
¤Ó·PÁ¤F~:)
¾Ç²ß¤¤~

GBKEE

¦^´_ 2# lpk187
¤@¦¸ªº°j°é

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Ar(), i As Integer
   
4.     With Range([B2], Range("b2").End(xlToRight).End(xlDown))
   
5.         ReDim Ar(1 To .Count, 1 To 2)
   
6.         For i = 1 To .Count
   
7.             Ar(i, 1) = .Cells(i).End(xlToLeft) & .Cells(i).End(xlUp)
   
8.             Ar(i, 2) = .Cells(i)
   
9.         Next
   
10.         .Cells(.Rows.Count + 2, 1).Resize(.Count, 2) = Ar
    
11.     End With
    
12. End Sub

½Æ»s¥N½X

lpk187

¦^´_ 5# GBKEE


   Try¹Lª©¤jªºµ{¦¡½X«á¡Aª©¤j§A¤Ó±j¤j¤F¡A¤§«e¨S¤°»ò¾Ç¨ìwith...
¸g¹L³oµ{¦¡¯uÅý§Ú¾Ç¨ìÆZ«p¹êªº¸gÅç¡A­ì¨ÓWith ³o»ò¦n¥Î¡AGBKEEª©¤j¡A·PÁ¡I

boblovejoyce

¦^´_ 4# GBKEE

wow~ÁÂÁª©¤j´£¨Ñ³oºØ¤è¦¡~
¨º¦³µL¥i¥H¤ÏÂà¦^¥h©O?

´N¹³¬O¦¹¨Ò,¥i¥HÂà­¼¨â¸ê®ÆÄæ
¦pªG¥u¦³¨â¸ê®ÆÄæ~¥i¥HÂà¦^¥h°}¦Cªº¼Ë¦¡¶Ü?

c_c_lai

¦^´_  GBKEE

wow~ÁÂÁª©¤j´£¨Ñ³oºØ¤è¦¡~
¨º¦³µL¥i¥H¤ÏÂà¦^¥h©O?

´N¹³¬O¦¹¨Ò,¥i¥HÂà­¼¨â¸ê®ÆÄæ
¦pªG ...
boblovejoyce µoªí©ó 2015-7-1 22:25

§A«üªº¬O¡H

1.         .Cells(.Rows.Count + 2, 1).Resize(.Count, 2) = Ar
   
2.        [F1].Resize(UBound(Ar, 2), 4) = Application.Transpose(Ar)

½Æ»s¥N½X

boblovejoyce

¦^´_ 4# GBKEE

ªO¥D¤j¤j~
¨ä¹ê¬O·Q¸ß°Ý,¦p¤U¹Ï
¥ª¹Ï:¸g¹L¤j¤jªºµ{¦¡½X,¤w¸g¥i¥HÂà¸m¤F

¦ý¦pªG¤Ï¹L¨Ó,µ¹ªº¬O¥k¹Ï
«ç»ò±NF G Äæ¦ì ,Âন I J K©O?

  

¤U¸ü (25.43 KB)

2015-7-3 08:37

GBKEE

¦^´_ 8# boblovejoyce
¸Õ¸Õ¬Ý

1. Option Explicit
   
2. Sub Ex()
   
3.     Dim Rng As Range, Ar1(), x As Integer, Ar2(), i As Integer
   
4.     Set Rng = [F1]
   
5.     Do While Rng <> ""
   
6.         i = 0
   
7.         If Mid(Rng, 1, 1) = Mid(Rng.Offset(i), 1, 1) Then
   
8.             ReDim Preserve Ar1(x + 1)
   
9.             ReDim Ar2(i)
   
10.             Ar2(i) = Mid(Rng, 1, 1)
    
11.             Do While Mid(Rng, 1, 1) = Mid(Rng.Offset(i), 1, 1)
    
12.                 i = i + 1
    
13.                 ReDim Preserve Ar2(i)
    
14.                 Ar2(i) = Rng.Offset(i - 1, 1)
    
15.             Loop
    
16.             Ar1(x + 1) = Ar2
    
17.             Set Rng = Rng.Offset(i)
    
18.             x = x + 1
    
19.         End If
    
20.     Loop
    
21.     ReDim Ar2(i)
    
22.     For i = 0 To i
    
23.         Ar2(i) = IIf(i > 0, i, "")
    
24.     Next
    
25.     Ar1(0) = Ar2
    
26.     For i = 0 To UBound(Ar1)
    
27.         [I1].Offset(i).Resize(, UBound(Ar1) + 1) = Ar1(i) '¤@¦æ¤@¦æªº¼g¤J
    
28.     Next
    
29.     '*********** ¤@¦¸¼g¤J
    
30.     [I1].Resize(UBound(Ar1) + 1, UBound(Ar2) + 1).Value = Application.Transpose(Application.Transpose(Ar1))
    
31. End Sub

½Æ»s¥N½X

lpk187

¦^´_ 9# GBKEE


    ½Ð±ÐG¤j¡A°²³]¡A§Ú¦bFÄ檺¦WºÙ¤¤¦³A1,A2,AA1,AA2, AAA1,AAA2®É¡A­n«ç»ò­×§ï¡H