在多个文本文件中搜索特定的数据行,然后使用VBA宏将其导入excel

时间:2019-03-29 20:26:17

标签: excel vba

我对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

2 个答案:

答案 0 :(得分:0)

也许是这样的:

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

答案 1 :(得分:0)

对我有用的最终结果!

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