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