果然有高人!非常感谢syh878,你的方法比我的简单简单多了。我在你的基础上将判断小数点的代码改为:
Option Explicit
Private Sub Command1_Click()
Dim A As String
A = Text1
A = NumStr(A)
Text1 = A
End Sub
Private Function NumStr(ByVal Str As String)
Dim TempStr$
Dim NextNum As Integer
Dim i As Integer
For i = 1 To Len(Str)
If IsNumeric(Mid(Str, i, 1)) Or Mid(Str, i, 1) = "." Then
TempStr = TempStr & Mid(Str, i, 1)
If Not IsNumeric(Mid(Str, i + 1, 1)) And Mid(Str, i, 1) <> "." Then
TempStr = TempStr & ","
End If
End If
Next
NumStr = TempStr
End Function
同时,请大家帮我改一下我自己编的代码:
Option Explicit
Private N() As String '''''存储提取的值
Private k As Integer '''''组数
Private U As Integer '''''Text1数组Index的上边界值
Private Sub Command1_Click()
Dim A As String
Dim i As Integer
On Error GoTo ProcError
A = Text1(0).Text
Me.GetNumber (A)
For i = 1 To k
Text1(i) = N(i)
Next
For i = k + 1 To U
Text1(i) = ""
Next
If U > k Then
For i = U To k + 1 Step -1
Unload Text1(i)
Me.Height = Me.Height - (Text1(i - 1).Top - Text1(i - 2).Top)
Next
End If
ProcExit:
Exit Sub
ProcError:
' MsgBox Err.Number & vbCrLf & Err.Description, 48
Select Case Err.Number
Case 340
Dim V As Integer
V = Text1(i - 1).Top - Text1(i - 2).Top
Load Text1(i)
Text1(i).Left = Text1(0).Left
Text1(i).Top = Text1(i - 1).Top + V
Text1(i).Height = Text1(i).Height
Text1(i).Width = Text1(i).Width
Text1(i).Visible = True
U = i
If Me.ScaleHeight <= Text1(i).Top + Text1(i).Height Then
' On Error GoTo ProcError
Me.Height = Me.Height + V
End If
Resume
' Case 384
' Resume Next
Case Else
End Select
End Sub
Public Sub GetNumber( _
ByVal mString As String _
)
Dim i As Integer
Dim L As Integer
Dim G(100) As Integer
Dim P(50) As Integer
Dim Ascii As Integer
Dim Temp As Integer
Dim J As Integer
Dim Start As Integer
Dim mL As Integer
On Error GoTo ProcError
L = Len(mString)
J = 0
k = 0
For i = 1 To L
Ascii = Asc(Mid$(mString, i, 1))
If Ascii <= 58 And Ascii >= 48 Then
''''记录每个数字的位置''''''''''''
J = J + 1
G(J) = i
End If
Next
''''''''(1)如果没有数字''''''''
If J = 0 Then
k = 0
GoTo ProcExit
End If
''''''''(2)如果只有一个数字''''''''
If J = 1 Then
k = 1
ReDim N(k)
N(k) = Mid$(mString, G(1), 1)
GoTo ProcExit
End If
''''''''(3)如果有>=2个数字''''''''
'''''''''(3-1)检查数字之间是否相连,是否为一组数字'''''''''
Dim IfOne As Boolean
IfOne = True
For i = 2 To J
Temp = G(i) - G(i - 1)
If Temp <> 1 Then
k = k + 1
IfOne = False
Exit For
End If
Next
If IfOne = True Then
k = 1
ReDim N(1)
mL = G(J) - G(1) + 1
N(1) = Mid$(mString, G(1), mL)
GoTo ProcExit
End If
'''''''''(3-2)说明有>=2组的数字串'''''''''
Dim b As Integer
b = 0
Start = G(1)
For i = 2 To J
Temp = G(i) - G(i - 1)
If Temp > 1 Then
k = k + 1
b = b + 1
P(2 * b - 1) = Start
P(2 * b) = G(i - 1)
Start = G(i)
End If
Next
P(2 * b + 1) = Start
P(2 * b + 2) = G(J)
ReDim N(k)
If k = 1 Then
N(1) = Mid$(mString, P(1), 1)
GoTo ProcExit
Else
For i = 1 To k
mL = P(2 * i) - P(2 * i - 1) + 1
N(i) = Mid$(mString, P(2 * i - 1), mL)
Next
End If
ProcExit:
Exit Sub
ProcError:
MsgBox Err.Number & vbCrLf & Err.Description, 48
Resume ProcExit
End Sub
Private Sub Form_Load()
U = 4
End Sub