本帖最后由 爱疯 于 2019-10-10 19:54 编辑
Sub test()
Dim A, B, i, s
A = Sheets(1).Range("a1").CurrentRegion
Sheets(2).Select
Rows("2:" & Rows.Count) = ""
B = Range("a1").CurrentRegion
ReDim B(1 To 10 ^ 4, 1 To UBound(B, 2)) '如果记录数>1万再改
For i = 1 To UBound(A) Step 6
s = s + 1
B(s, 4) = A(i + 1, 2) '公司名称
B(s, 9) = A(i + 2, 2) '公司地址
B(s, 8) = A(i + 3, 2) '税号
B(s, 11) = f(A(i + 4, 2), "\d+") '银行账号 - 汉字
B(s, 12) = f(A(i + 4, 2), "[\u4E00-\u9FA5]+") '银行账号 - 数字
B(s, 10) = A(i + 5, 2) '电话
Next i
Range("a2").Resize(s, UBound(B, 2)) = B
End Sub
'提取汉字或数字(原字符串, 正则)
Function f(x, y)
With CreateObject("VBScript.RegExp")
.Pattern = y
f = .Replace(x, "")
End With
End Function
1.rar
(19.11 KB, 下载次数: 14)
|