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

Hsieh

¦^´_ 3# sammyc

¤U¸ü (8.5 KB)

2011-2-18 17:42

   

¤U¸ü (16.04 KB)

2011-2-18 17:41