在多个文本文件中搜索特定数据行并使用 VBA 宏导入 excel

Question

我对 VBA 非常陌生，我希望使用它来自动化我的一些流程。我环顾了这个网站（和其他网站），虽然我发现了非常相似的查询，但我似乎无法找到完全符合我需求的查询。

到目前为止，我发现的最接近我想要做的事情是：Wanting to create a search field and button to trigger VBA script to run

我有一个包含所有数据的源文件夹。我的数据存储在多个文本文件中。以下是文件中数据的示例：

10001,1,205955.00
10001,2,196954.00
10001,3,4.60
10001,4,92353.00
10001,5,85015.00
10001,6,255.90
10001,7,804.79
10001,8,205955.00
10001,9,32465.00

在每一行中，第一个数字是地理代码，第二个数字是特定指标的数字代码（对于我想要做的事情并不重要），第三个数字是我要导入的值我的电子表格。每个地理代码与 2247 行相关联。

我想在 Excel 中使用一个搜索框控件，我可以在其中键入特定的地理代码，单击一个按钮，然后宏将运行，在文件中搜索该特定代码，然后导入所有值 - 按顺序它们列在数据文件中 - 进入工作簿中我想要的范围。

到目前为止，我已经编写了这段代码。再次，如果这是糟糕的代码，请原谅我......我试图重新利用我之前提到的其他论坛帖子中的代码。

我想我设置了正确的导入位置...我希望它导入到 C 列，搜索框/按钮组合将出现的工作表的第 3 行。但现在，我不确定如何让导入方面发挥作用。提前感谢任何可以帮助解决此问题的人。

Sub SearchFolders()

Dim FSO As Object
Dim Folder As Object
Dim File As Object
Dim TS As Object
Dim SourceFolder As String
Dim Search As String
Dim LineNumber As Long
Dim DataSh As Worksheet

SourceFolder = "C:\Users\MarMar\Desktop\Data\Census2016\DataFiles\"
Search = TextBox1.Value

Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(SourceFolder)
Set DataSh = ActiveSheet.Cells(3, 3)

For Each File In Folder.Files
   Set TS = File.OpenAsTextStream()
   LineNumber = 0

      Do While Not TS.AtEndOfStream
      LineNumber = LineNumber + 1

      If InStr(TS.ReadLine, Search) Then

      'Code to Import Values to DataSh ???

      End If
      Loop

   TS.Close
   Next File

 End Sub

Answer 1

可能是这样的：

Dim arr

For Each File In Folder.Files
    Set TS = File.OpenAsTextStream()
    LineNumber = 0

    Do While Not TS.AtEndOfStream

        arr = Split(TS.ReadLine, ",") 'split line to array

        'check first element in array
        If arr(0) = Search Then

            datash.Resize(1, UBound(arr) + 1).Value = arr
            Set datash = datash.Offset(1, 0)

        End If
    Loop

    TS.Close
Next File

Answer 2

对我有用的最终结果！

Sub SearchImportData1()

Dim FSO As Object
Dim SourceFolder As String
Dim Folder As Object
Dim Import As Range
Dim Search As String
Dim TextBox1 As TextBox
Dim File As Object
Dim TS As Object
Dim LineNumber As Integer
Dim Arr As Variant

SourceFolder = "C:\Users\MarMar\Desktop\Data\Census2016\DataFiles\"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(SourceFolder)
Set Import = ActiveSheet.Cells(2, 3)

Search = ActiveSheet.TextBox1.Text

For Each File In Folder.Files

    Set TS = File.OpenAsTextStream()
    LineNumber = 0

      Do While Not TS.AtEndOfStream

      Arr = Split(TS.ReadLine, ",")

         If Arr(0) = Search Then
         Import.Resize(1, 1).Value = Arr(2)
         Set Import = Import.Offset(1, 0)
         End If

      Loop

    TS.Close
    Next File

End Sub