|
Sub 填写数据2() '取特殊字符法
Dim Hang As Long, ShuRuHang As Long, lie2 As Long, lie3 As Long, TeShuZhiFu4 As Long
Dim TeShuZhiFu As Long, TeShuZhiFu1 As Long, TeShuZhiFu2 As Long, TeShuZhiFu3 As Long
Dim lie
Dim arr()
'Call 关闭计算机
Range("A2:D" & [A1].End(xlDown).Row).Cells.ClearContents
For Hang = 2 To [G1].End(xlDown).Row
Application.StatusBar = "掉落生成进度:" & Int(Hang / [G1].End(xlDown).Row * 10000) / 100 & "%"
TeShuZhiFu = Len(Cells(Hang, 8)) - Len(Application.Substitute(Cells(Hang, 8), ",", "")) - 2
For lie3 = 1 To TeShuZhiFu
TeShuZhiFu1 = Application.IfError(Application.Find("@", Application.Substitute(Cells(Hang, 8), ",", "@", lie3)), 0)
TeShuZhiFu2 = Application.IfError(Application.Find("@", Application.Substitute(Cells(Hang, 8), ",", "@", lie3 + 1)), 0)
TeShuZhiFu3 = Application.IfError(Application.Find("@", Application.Substitute(Cells(Hang, 8), ",", "@", lie3 + 2)), 0)
If [A2] = "" Then
ShuRuHang = 2
Else
ShuRuHang = [A1].End(xlDown).Row + 1
End If
If lie3 = 1 Then
Cells(ShuRuHang, 2) = Left(Cells(Hang, 8), TeShuZhiFu1 - 1)
Cells(ShuRuHang, 3) = Mid(Cells(Hang, 8), TeShuZhiFu1 + 1, TeShuZhiFu2 - TeShuZhiFu1 - 1)
Cells(ShuRuHang, 4) = Mid(Cells(Hang, 8), TeShuZhiFu2 + 1, TeShuZhiFu3 - TeShuZhiFu2 - 1)
Else
Cells(ShuRuHang, 2) = Mid(Cells(Hang, 8), TeShuZhiFu1 + 1, TeShuZhiFu2 - TeShuZhiFu1 - 1)
If lie3 = TeShuZhiFu Then
TeShuZhiFu1 = Application.IfError(Application.Find("@", Application.Substitute(Cells(Hang, 8), ",", "@", lie3 + 1)), 0)
Cells(ShuRuHang, 3) = Mid(Cells(Hang, 8), TeShuZhiFu2 + 1, TeShuZhiFu3 - TeShuZhiFu2 - 1)
Cells(ShuRuHang, 4) = Right(Cells(Hang, 8), Len(Cells(Hang, 8)) - TeShuZhiFu3)
Else
TeShuZhiFu1 = Application.IfError(Application.Find("@", Application.Substitute(Cells(Hang, 8), ",", "@", lie3 + 1)), 0)
TeShuZhiFu2 = Application.IfError(Application.Find("@", Application.Substitute(Cells(Hang, 8), ",", "@", lie3 + 2)), 0)
TeShuZhiFu3 = Application.IfError(Application.Find("@", Application.Substitute(Cells(Hang, 8), ",", "@", lie3 + 3)), 0)
Cells(ShuRuHang, 3) = Mid(Cells(Hang, 8), TeShuZhiFu1 + 1, TeShuZhiFu2 - TeShuZhiFu1 - 1)
Cells(ShuRuHang, 4) = Mid(Cells(Hang, 8), TeShuZhiFu2 + 1, TeShuZhiFu3 - TeShuZhiFu2 - 1)
End If
lie3 = lie3 + 1
End If
lie3 = lie3 + 1
Cells(ShuRuHang, 1) = Cells(Hang, 7)
Next
Next
Call 开启计算机
MsgBox "数据已提取完毕!", , "提示"
End Sub
在代码运行到Len(Application.Substitute(Cells(Hang, 8), ",", ""))时 |
|