Excel表格 vba怎么做信息整理？
发布网友
发布时间：2022-04-21 10:04
共1个回答
热心网友
时间：2023-11-09 12:53
Public Sub 遍历()
Dim arr, brr
Application.ScreenUpdating = False
Application.DisplayAlerts = False
t = Timer
mypath = ThisWorkbook.Path & "\"
myname = Dir(mypath & "*.xls*")
ReDim brr(1 To 1000000, 1 To 6)
n = 1
Do While myname <> ""
If myname <> ThisWorkbook.Name Then
Workbooks.Open (mypath & myname)
arr = ActiveSheet.Range("a1").CurrentRegion.Value
ActiveWorkbook.Close
For i = 1 To UBound(arr)
If arr(i, 5) = "签收" Or arr(i, 5) = "驿站代收" Or arr(i, 5) = "柜机代收" Then
For j = 1 To 6
brr(n, j) = arr(i, j)
Next
n = n + 1
End If
Next
End If
myname = Dir
Loop
ThisWorkbook.Sheets(1).[a1].Resize(1, 6) = arr
ThisWorkbook.Sheets(1).[a2].Resize(UBound(brr), 6) = brr
Columns(1).Select
Selection.TextToColumns Destination:=Selection, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
:=Array(1, 2), TrailingMinusNumbers:=True
MsgBox Timer - t
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
