[已解决]数字与非数字分离

lichuanboy44

详见下图

最佳答案

月排行榜 / 总排行榜

grf1973

2016-5-8 15:52

1. Sub tt()
   
2.     For i = 4 To 8
   
3.         x = Cells(i, 1)
   
4.         j = 2
   
5.         For k = 1 To Len(x)
   
6.             j = j + 1
   
7.             If Not IsNumeric(Mid(x, k, 1)) Then
   
8.                 Cells(i, j) = Mid(x, k, 1)
   
9.             Else
   
10.                 Cells(i, j) = Val(Mid(x, k))
    
11.                 k = k + Len(Cells(i, j)) - 1
    
12.             End If
    
13.         Next
    
14.     Next
    
15. End Sub
    

复制代码

跳转到最佳答案楼层

baksy

附件

grf1973

1. Sub tt()
   
2.     For i = 4 To 8
   
3.         x = Cells(i, 1)
   
4.         j = 2
   
5.         For k = 1 To Len(x)
   
6.             j = j + 1
   
7.             If Not IsNumeric(Mid(x, k, 1)) Then
   
8.                 Cells(i, j) = Mid(x, k, 1)
   
9.             Else
   
10.                 Cells(i, j) = Val(Mid(x, k))
    
11.                 k = k + Len(Cells(i, j)) - 1
    
12.             End If
    
13.         Next
    
14.     Next
    
15. End Sub
    

复制代码

dsmch

1. Sub Macro1()
   
2. With CreateObject("vbscript.regexp")
   
3.     .Pattern = "^\d+"
   
4.     .Global = True
   
5.     For j = 4 To 8
   
6.         s = 2
   
7.         x = Cells(j, 1)
   
8.         For i = 1 To Len(x)
   
9.             If Not Mid(x, i, 1) Like "#" Then
   
10.                s = s + 1: Cells(j, s) = Mid(x, i, 1)
    
11.             Else
    
12.                 y = .Execute(Mid(x, i))(0)
    
13.                 s = s + 1: Cells(j, s) = Val(y)
    
14.                 i = i + Len(y) - 1
    
15.             End If
    
16.         Next
    
17.     Next
    
18. End With
    
19. End Sub

复制代码

上清宫主

以下两段均可适用于含有小于1的数
Sub test1()
Dim ar1(), ar2() As String
ar1 = [a4:a8].Value
ReDim ar2(1 To UBound(ar1), 1 To 20)
For i1 = 1 To UBound(ar1)
    c% = 0: t = 0
    For i2% = 1 To Len(ar1(i1, 1))
        s$ = Mid(ar1(i1, 1), i2, 1)
        If s Like "[.0-9]" Then
           If t = 0 Then t = 1: c = c + 1
        Else
           If t Then t = 0
           c = c + 1
        End If
        ar2(i1, c) = ar2(i1, c) & s
    Next
Next
[c4].Resize(i1 - 1, UBound(ar2, 2)) = ar2
End Sub


Sub test2()
Dim ar1(), ar2() As String
ar1 = [a4:a8].Value
ReDim ar2(1 To UBound(ar1), 1 To 20)
For i1 = 1 To UBound(ar1)
    c% = 0
    Do While Len(ar1(i1, 1))
       c = c + 1
       If Left(ar1(i1, 1), 1) Like "[0-9]" Then
          ar2(i1, c) = Val(ar1(i1, 1))
          t = 1
          If Left(ar2(i1, c), 1) = "." Then t = 2
          ar1(i1, 1) = Mid(ar1(i1, 1), Len(ar2(i1, c)) + t)
       Else
          ar2(i1, c) = Left(ar1(i1, 1), 1)
          ar1(i1, 1) = Mid(ar1(i1, 1), 2)
       End If
    Loop
Next
[c4].Resize(i1 - 1, UBound(ar2, 2)) = ar2
End Sub