本帖最后由 风林火山 于 2021-7-31 15:57 编辑
Dim arr, strxlsx As String, strtxt As String, wk As Workbook, n As Byte
Dim iRow As Long, a, b, c(), m
On Error Resume Next
arr = Application.GetOpenFilename("Excel Files (*.xls*), *.xls*", 2, , True)
If arr(1) <> "flase" Then
For n = 1 To UBound(arr)
Set wk = Application.Workbooks.Open(arr(n))
iRow = ActiveSheet.Cells(Rows.Count, 1).End(3).Row + 1
strtxt = ActiveWorkbook.Path & "/" & Replace(ActiveWorkbook.Name, ".xlsx", "") & ".txt"
Open strtxt For Input As #1
Do While Not EOF(1)
Line Input #1, a
If InStr(a, "通达") = 0 Then
b = Split(a, " ")
m = m + 1
ReDim Preserve c(1 To 2, 1 To m)
c(1, m) = b(0): c(2, m) = b(4)
Erase b
End If
Loop
Close #1
Cells(iRow, 1).Resize(m, 2) = Application.WorksheetFunction.Transpose(c)
iRow = ActiveSheet.Cells(Rows.Count, 1).End(3).Row + 1
wk.Close
Set wk = Nothing
Next n
End If
End Sub
|