Question

我在以下链接中找到了用于查找特定字符串的资源：https://www.excel-easy.com/vba/examples/read-data-from-text-file.html

如何将其应用于文件夹中的所有.txt文件？

Sub READLINES()
Dim myFile As String, text As String, textline As String, posFood As Integer
'myFile = "C\FOLDER\TEST.txt"
myFile = Application.GetOpenFilename()

Open myFile For Input As #1

Do Until EOF(1)
    Line Input #1, textline
    text = text & textline
Loop
Close #1

posFood = InStr(text, "BACON")
Range("A1").Value = Mid(text, posFood + 7, 3) 'should return YUM

End Sub

Answer 1

我认为最好的选择是将所有文本文件中的所有数据导入到一张纸中，然后过滤要查找的字符串，然后将其复制/粘贴到另一张纸中。

尝试以下脚本从所有文件导入所有数据。

Sub ImportCSVsWithReference()
'UpdatebyKutoolsforExcel20151214
    Dim xSht  As Worksheet
    Dim xWb As Workbook
    Dim xStrPath As String
    Dim xFileDialog As FileDialog
    Dim xFile As String
    On Error GoTo ErrHandler
    Set xFileDialog = Application.FileDialog(msoFileDialogFolderPicker)
    xFileDialog.AllowMultiSelect = False
    xFileDialog.Title = "Select a folder [Kutools for Excel]"
    If xFileDialog.Show = -1 Then
        xStrPath = xFileDialog.SelectedItems(1)
    End If
    If xStrPath = "" Then Exit Sub
    Set xSht = ThisWorkbook.ActiveSheet
    If MsgBox("Clear the existing sheet before importing?", vbYesNo, "Kutools for Excel") = vbYes Then xSht.UsedRange.Clear
    Application.ScreenUpdating = False
    xFile = Dir(xStrPath & "\" & "*.txt")
    Do While xFile <> ""
        Set xWb = Workbooks.Open(xStrPath & "\" & xFile)
        Columns(1).Insert xlShiftToRight
        Columns(1).SpecialCells(xlBlanks).Value = ActiveSheet.Name
        ActiveSheet.UsedRange.Copy xSht.Range("A" & Rows.Count).End(xlUp).Offset(1)
        xWb.Close False
        xFile = Dir
    Loop
    Application.ScreenUpdating = True
    Exit Sub
ErrHandler:
    MsgBox "no files csv", , "Kutools for Excel"
End Sub

然后运行。

Sub MoveData()

With Application
.ScreenUpdating = False
.EnableEvents = False
End With

Dim Rng As Range

Set Rng = Range([A1], Range("A" & Rows.Count).End(xlUp))

On Error Resume Next
With Rng
.AutoFilter , field:=1, Criteria1:="Book1"
.SpecialCells(xlCellTypeVisible).EntireRow.Copy Sheets("Sheet2").Range("A1")
.AutoFilter
End With

Application.EnableEvents = True

End Sub

VBA：如何从文件夹中的所有txt文件读取和复制特定的字符串

1 个答案: