[已解决]拆分单元格内的数据141

wucj80

拆分单元格内的数据141

最佳答案

月排行榜 / 总排行榜

柳如烟

2012-8-21 23:33

1. 
   
2. Sub 拆分单元格内数据()
   
3.     Dim arr, brr(1 To 10000, 1 To 4), a
   
4.     Dim i%, j%, k%, m%, n%, s$, str$
   
5.     arr = Range("a2:d" & Range("a65536").End(3).Row)
   
6.     For i = 1 To UBound(arr)
   
7.         a = Split(arr(i, 1), "/")
   
8.         For j = 0 To UBound(a)
   
9.             For m = 1 To Len(a(j))
   
10.                 If IsNumeric(Mid(a(j), m, 1)) Then
    
11.                     n = Mid(a(j), m)
    
12.                     s = Left(a(j), m - 1)
    
13.                     Exit For
    
14.                 End If
    
15.             Next
    
16.             For m = 1 To Len(s) Step 2
    
17.                 str = Mid(s, m, 2)
    
18.                 k = k + 1
    
19.                 brr(k, 1) = str & n
    
20.                 brr(k, 2) = arr(i, 2)
    
21.                 brr(k, 3) = arr(i, 3)
    
22.                 brr(k, 4) = arr(i, 4)
    
23.             Next
    
24.         Next
    
25.     Next
    
26.     With Range("e2").Resize(k, 4)
    
27.         .ClearContents
    
28.         .Value = brr
    
29.     End With
    
30. End Sub
    

复制代码

看着你的结果写的。

跳转到最佳答案楼层

柳如烟

1. 
   
2. Sub 拆分单元格内数据()
   
3.     Dim arr, brr(1 To 10000, 1 To 4), a
   
4.     Dim i%, j%, k%, m%, n%, s$, str$
   
5.     arr = Range("a2:d" & Range("a65536").End(3).Row)
   
6.     For i = 1 To UBound(arr)
   
7.         a = Split(arr(i, 1), "/")
   
8.         For j = 0 To UBound(a)
   
9.             For m = 1 To Len(a(j))
   
10.                 If IsNumeric(Mid(a(j), m, 1)) Then
    
11.                     n = Mid(a(j), m)
    
12.                     s = Left(a(j), m - 1)
    
13.                     Exit For
    
14.                 End If
    
15.             Next
    
16.             For m = 1 To Len(s) Step 2
    
17.                 str = Mid(s, m, 2)
    
18.                 k = k + 1
    
19.                 brr(k, 1) = str & n
    
20.                 brr(k, 2) = arr(i, 2)
    
21.                 brr(k, 3) = arr(i, 3)
    
22.                 brr(k, 4) = arr(i, 4)
    
23.             Next
    
24.         Next
    
25.     Next
    
26.     With Range("e2").Resize(k, 4)
    
27.         .ClearContents
    
28.         .Value = brr
    
29.     End With
    
30. End Sub
    

复制代码

看着你的结果写的。