|
各位大侠,如上图文正常的12位文本通过以下代码是可以提取的:
Private Sub CommandButton1_Click()
Dim i As Integer, str, str2 As String, rng As Variant
syfwl = 2
clsjl = 2
qsh = 2
csh = Sheet0.Cells(1, 1)
With Sheet1
h = .Cells(65536, clsjl).End(xlUp).Row() - qsh
rng = .Range(.Cells(qsh + 1, 1), .Cells(h + qsh, syfwl))
End With
On Error GoTo cuow
ReDim cs(1 To csh, 1 To syfwl)
ii = 0
For ij = 1 To h
str2 = ""
j = 0
For i = 1 To Len(rng(ij, clsjl))
str = Mid(rng(ij, clsjl), i, 1)
j = j + 1
If str Like "[0-9]" Then
str2 = str2 & str
If j = 12 Then
ii = ii + 1
For jj = 1 To syfwl
cs(ii, jj) = rng(ij, jj)
Next jj
cs(ii, clsjl) = "'" & str2
str2 = ""
j = 0
End If
Else
If j > 10 Then
ii = ii + 1
For jj = 1 To syfwl
cs(ii, jj) = rng(ij, jj)
Next jj
cs(ii, clsjl) = "错误" & str2
End If
str2 = ""
j = 0
End If
Next i
Next ij
With Sheet2
If ii > 0 Then
.Range(.Cells(qsh + 1, 1), .Cells(ii + qsh, syfwl)) = cs
End If
End With
Sheet2.Activate
MsgBox "ok"
Exit Sub
|
|