[¨D§U] ±NÉN¯S©w®æ¦¡, ¤À¦¨¦h¦C

sammyc

¦p·Q¥Î vba ±NgxmcÄ椺¦p¦³¦h²Õ¼Æ¦r, ¤À¦¨¦h¦æ¸ê®Æ, ¸Ó¦p¦ó°µ,

bh                            gh                                wltm            gxmc              color           csize        shul2
12195-03A        EF03500                               14939        ,1,                CH012        42        72
12195-03A        EF03622                               14930        ,2,9,                CH012        38        48
12195-03A        EF03661                               14940        ,10,2,7,4,        CH012        42        48
                                               
µ²ªG                                               
bh                            gh                                wltm            gxmc        color           csize        shul2                                               
12195-03A        EF03500                               14939        ,1,        CH012        42        72
12195-03A        EF03622                               14930        ,2,        CH012        38        48
12195-03A        EF03622                               14930        ,9,        CH012        38        48
12195-03A        EF03661                               14940        ,10,        CH012        42        48
12195-03A        EF03661                               14940        ,2,        CH012        42        48
12195-03A        EF03661                               14940        ,7,        CH012        42        48
12195-03A        EF03661                               14940        ,4,        CH012        42        48

Hsieh

¦^´_ 1# sammyc

1. Sub ex()
   
2. Dim Ar()
   
3. For Each a In Range([A1], [A65536].End(xlUp))
   
4. If InStr(a.Offset(, 3), ",") = 0 Then
   
5.    ReDim Preserve Ar(s)
   
6.    Ar(s) = Array(a.Value, a.Offset(, 1).Value, a.Offset(, 2).Value, a.Offset(, 3).Value, a.Offset(, 4).Value, a.Offset(, 5).Value, a.Offset(, 6).Value)
   
7.    s = s + 1
   
8.    Else
   
9.    ay = Split(a.Offset(, 3), ",")
   
10.    For Each c In ay
    
11.      If c <> "" Then
    
12.      ReDim Preserve Ar(s)
    
13.      Ar(s) = Array(a.Value, a.Offset(, 1).Value, a.Offset(, 2).Value, "," & c & ",", a.Offset(, 4).Value, a.Offset(, 5).Value, a.Offset(, 6).Value)
    
14.      s = s + 1
    
15.      End If
    
16.    Next
    
17. End If
    
18. Next
    
19. [I1].Resize(s, 7) = Application.Transpose(Application.Transpose(Ar))
    
20. End Sub

½Æ»s¥N½X

sammyc

¦^´_ 1# sammyc
¥ý¦æÁÂÁÂ, ¦ý°õ¦æ«á, ¨S¥ô¦óÅÜ°Ê,
¦æ¨ì s = s + 1«á, ¤v¸õ¨ìnext

   Ar(s) = Array(a.Value, a.Offset(, 1).Value, a.Offset(, 2).Value, a.Offset(, 3).Value, a.Offset(, 4).Value, a.Offset(, 5).Value, a.Offset(, 6).Value)
   s = s + 1
   Else
   ay = Split(a.Offset(, 3), ",")
   For Each c In ay
     If c <> "" Then
     ReDim Preserve Ar(s)
     Ar(s) = Array(a.Value, a.Offset(, 1).Value, a.Offset(, 2).Value, "," & c & ",", a.Offset(, 4).Value, a.Offset(, 5).Value, a.Offset(, 6).Value)
     s = s + 1
     End If
   Next
End If

Hsieh

¦^´_ 3# sammyc

¤U¸ü (8.5 KB)

2011-2-18 17:42

   

¤U¸ü (16.04 KB)

2011-2-18 17:41

sammyc

¤v¸Ñ¨M, ÁÂÁÂ

GBKEE

¦^´_ 1# sammyc

1. Sub Ex()
   
2. Dim Ar(), S As Integer, A As Range, I As Integer, T As String
   
3. For Each A In Range([A1], [A65536].End(xlUp))
   
4.     For I = 0 To UBound(Split(A.Cells(1, 4), ","))
   
5.         If Split(A.Cells(1, 4), ",")(I) <> "" Then
   
6.             ReDim Preserve Ar(S)
   
7.             Ar(S) = Application.Transpose(Application.Transpose(A.Resize(1, 7).Value))
   
8.             T = IIf(UBound(Split(A.Cells(1, 4), ",")) > 0, ",", "")
   
9.             Ar(S)(4) = T & Split(A.Cells(1, 4), ",")(I) & T
   
10.             S = S + 1
    
11.         End If
    
12.     Next
    
13. Next
    
14. [I1].Resize(S, 7) = Application.Transpose(Application.Transpose(Ar))
    
15. End Sub

½Æ»s¥N½X