Sub 数据导入()
Dim f, arr, i&, j&, k, m%, n%, p%, sh As Workbook
f = Application.GetOpenFilename(filefilter:="Excel文件(*xls), *xls", Title:="选择Excel文件", MultiSelect:=True)
If TypeName(f) = "boolean" Then Exit Sub
Application.ScreenUpdating = False
Set sh = ThisWorkbook
sh.Sheets("客户导入样表").UsedRange.Offset(1).Delete
For i = 1 To UBound(f)
With GetObject(f(i))
j = Application.CountA(sh.Sheets("客户导入样表").[b:b])
.Sheets(1).Range("b4").Copy
sh.Sheets("客户导入样表").Range("b" & j + 1 & " : " & "c" & j + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
.Sheets(1).Range("b6").Copy
sh.Sheets("客户导入样表").Range("d" & j + 1 & " : " & "e" & j + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
k = .Sheets(1).Range("b7").Value
m = InStr(1, k, "省")
n = InStr(1, k, "市")
p = InStr(1, k, "区")
sh.Sheets("客户导入样表").Range("r" & j + 1) = Left(k, m)
sh.Sheets("客户导入样表").Range("g" & j + 1) = Mid(k, m + 1, n - m)
sh.Sheets("客户导入样表").Range("s" & j + 1) = Mid(k, m + 1, n - m)
sh.Sheets("客户导入样表").Range("t" & j + 1) = Mid(k, n + 1, p - n)
sh.Sheets("客户导入样表").Range("v" & j + 1 & " : " & "w" & j + 1) = k
.Close False
End With
Next
MsgBox "导入完成！"
Application.ScreenUpdating = True
End Sub