我有一個大的 .txt 檔案串列，我需要一個宏來執行以下操作：
- 打開檔案
- 以“|”分隔檔案
- 全選然后過濾
- 按特定標題排序
第 3 步和第 4 步很簡單……如果這些檔案不都是 .txt 和 | 分隔符，我知道如何打開多個檔案然后過濾/排序，我遇到的問題是第 2 步。
到目前為止的代碼：
Option Explicit
Dim theDir As String, wk As Workbook, numFiles As Integer, s As String, r As Range
Const ext = ".txt"
Sub LoopThroughFiles()
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
theDir = ThisWorkbook.Path
s = Dir(theDir & "\*" & ext)
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem & "*.txt*")
Do While xFileName <> ""
With Workbooks.Open(xFdItem & xFileName)
'your code here
Set r = Range(Range("A1"), Range("A1").End(xlDown))
r.TextToColumns Destination:=r, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=True, Space:=False, Other:=True, OtherChar:="|", _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), _
Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array( _
46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), _
Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array( _
59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1)), TrailingMinusNumbers:=True
Application.DisplayAlerts = False
s = Dir()
numFiles = numFiles 1
xFileName = Dir
End With
Loop
End If
End Sub
此代碼有效...但僅適用于第一列，我在某些檔案中有超過 70 列。
uj5u.com熱心網友回復：
您可以使用該Workbooks.OpenText方法-我認為管理起來更容易
Sub Tester()
Dim wb As Workbook
Set wb = GetWorkbook("C:\Temp\pipes.txt")
Debug.Print wb.Name
End Sub
Function GetWorkbook(fpath) As Workbook
Workbooks.OpenText Filename:=fpath, Origin:=437, StartRow:= _
1, DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, _
ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False, Comma:=False _
, Space:=False, Other:=True, OtherChar:="|", TrailingMinusNumbers:=True
Set GetWorkbook = ActiveWorkbook
End Function
uj5u.com熱心網友回復：
您正在選擇這行代碼中的第一列。
Set r = Range(Range("A1"), Range("A1").End(xlDown))
如果檔案是由管道符號分隔的文本，這應該沒問題。但是，如果檔案中有逗號，它會自動將逗號后面的資料分成另一列。
嘗試直接以文本模式打開檔案。
舉個例子
Workbooks.OpenText Filename:="C:\Temp\Test1.txt", _
Origin:=xlMSDOS, StartRow:=1, DataType:=xlDelimited, TextQualifier:= _
xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, Semicolon:=False _
, Comma:=False, Space:=False, Other:=True, OtherChar:="|", FieldInfo _
:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1)), _
TrailingMinusNumbers:=True
uj5u.com熱心網友回復：
我得到了這個作業：
Option Explicit
Dim theDir As String, wk As Workbook, numFiles As Integer, s As String, r As Range
Const ext = ".txt"
Sub LoopThroughFiles()
Dim xFd As FileDialog
Dim xFdItem As Variant
Dim xFileName As String
theDir = ThisWorkbook.Path
Dim wkbpath As String
Dim wkbname As String
Set xFd = Application.FileDialog(msoFileDialogFolderPicker)
If xFd.Show = -1 Then
xFdItem = xFd.SelectedItems(1) & Application.PathSeparator
xFileName = Dir(xFdItem) ' old version had: & "*.txt*")
Do While xFileName <> ""
With Workbooks.Open(xFdItem & xFileName)
'your code here
Set r = Range(Range("A1"), Range("A1").End(xlDown))
r.TextToColumns Destination:=r, DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar:="|", _
FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), _
Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1 _
), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), Array(19, 1), Array _
(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), Array(24, 1), Array(25, 1), Array(26, 1), _
Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array( _
33, 1), Array(34, 1), Array(35, 1), Array(36, 1), Array(37, 1), Array(38, 1), Array(39, 1), _
Array(40, 1), Array(41, 1), Array(42, 1), Array(43, 1), Array(44, 1), Array(45, 1), Array( _
46, 1), Array(47, 1), Array(48, 1), Array(49, 1), Array(50, 1), Array(51, 1), Array(52, 1), _
Array(53, 1), Array(54, 1), Array(55, 1), Array(56, 1), Array(57, 1), Array(58, 1), Array( _
59, 1), Array(60, 1), Array(61, 1), Array(62, 1), Array(63, 1), Array(64, 1)), TrailingMinusNumbers:=True
Application.DisplayAlerts = False
Cells.Select
Selection.AutoFilter
Application.AddCustomList ListArray:=Array("PREFERRED", "NON-PREFERRED", _
"UNACCEPTABLE", "OBSOLETE")
ActiveSheet.Sort.SortFields. _
Clear
ActiveSheet.Sort.SortFields. _
Add Key:=Range("D2:D479"), SortOn:=xlSortOnValues, _
CustomOrder:="PREFERRED,NON-PREFERRED,UNACCEPTABLE,OBSOLETE", DataOption:= _
xlSortNormal
With ActiveSheet.Sort
.SetRange Range("A1:BH79")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
xFileName = Dir
wkbpath = "C:\Users\tomas.breitinger\Desktop\BAE Export .DAT Files\Finished\"
wkbname = ActiveWorkbook.Name
ActiveWorkbook.SaveAs Filename:= _
wkbpath & wkbname & ".xlsx", FileFormat:=51, CreateBackup:=False
ActiveWorkbook.Close savechanges:=False
End With
End With
Loop
End If
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/caozuo/530979.html
標籤：擅长vba
上一篇：Excel使用SUMPRODUCT乘以列然后減少百分比列
下一篇：VBA，陣列回圈，下標超出范圍