将数据从多个文本文件导入Excel VBA [英] Importing data from multiple text files into Excel VBA
问题描述
我遇到的问题是我在文本文件中重复的测量值（称为MVA）具有相同的名称。我不需要文本文件中的所有数据，只有这些MVA的一些特定行（下面的例子让我们说，我只需要将LED 01强度的MVA号码存储在新的我需要从10个多个文本文件（我不知道的随机名称）中获取MVA行中的LED 01 Intensity之后的值，以将其存储在Excel中的单独单元格中从A1到A10）。
示例_____________________________________________________________________
名称：153588.txt
日期：14.05.2016
产品名称：电子设备01
检查测试
阻力101
MVA：2欧姆
MAX：5欧姆
MIN：0欧姆
PASS
LED 01强度
MVA：6250
MAX：10000
MIN：5000
PASS
我需要很多这些MVA值存储在Excel中进行分析，我需要知道如果这个问题可以用VBA解决。如果你能给我一些帮助来创建一个宏，我会很感激（我有基础的编程知识，但我是VBA的初学者）。
这是我答应的代码。实际上，根据您提供的说明，您不仅需要样本但实际代码。
请注意，我根据您提供的示例文件编写它 - 这意味着可能会失败并使用不同的文本文件结构。
您将注意到开始时有一个设置部分。这就是您设置需要提供代码的地方。
考虑到示例文件，您的系统的数百个文本文件将不会产生很大的影响 - 也许会在几秒钟内完成工作。但是，在代码执行期间，可能会在代码中禁用屏幕更新。如果您注意到真正的大系统缓慢，请参阅Excel Application对象的ScreenUpdating属性。
我希望为VBA提供一些良好的开端，所以我尝试使用许多方法和评论很多，以解释我们在每一步中正在做什么。例如，在新创建的工作簿中使用第一个工作表作为结果工作表，但为临时工作表创建一个新的工作表。有一个原因：每个新的工作簿都使用至少一个工作表创建，但它也可能是根据该计算机中的Excel设置的唯一一个工作表。然而，即使这些部分可以通过首先获得工作表的数量来设计不同，并删除不必要的数据，只保留2，然后再使用它们，而不是创建一个新的。
很快 - 有许多不同的方式来完成同样的任务 - 像许多其他的编程语言。例如，我使用QueryTable将数据导入到工作表中，然后使用Find方法来确定它是否具有我需要的值。我不必这样做，我可以把所有的信息放在一个字符串变量中，并在字符串中进行搜索！或通过使用另一种方法，或另一种方法。
最后这应该是你需要的。我希望它给你一个很好的开始。要使此代码工作：创建一个新的工作簿 - > goto VBA - >使用菜单和插入 - >模块 - >复制并将以下代码粘贴到编辑器中打开的右窗格中。在子过程开始时（可能只有路径变量）更改设置区域中必需的变量，并按F5运行代码。
Sub ImportData（）
Dim wrk As Workbook
Dim shtSource As Worksheet
Dim shtResult As Worksheet
Dim rng As Range
Dim fndSection As Range
Dim fndValue As Range
Dim data As QueryTable
Dim strFile
Dim strPath As String
Dim strExt As String
Dim strSection As String
Dim strValue As String
'======== BEGIN SETTINGS = =======
'定义文件路径 - 注意有最后一个反斜杠
strPath =C：\Users\smozgur\Desktop\files\
'定义文件扩展名
strExt =* .txt
'要查找的部分
strSection =Led 01 Intensity
'要查找的单元格值之后
strValue =MVA：
'======== END SETTINGS ========
'创建一个新工作簿不要混淆现有的
设置wrk = Application.Workbooks.Add
用wrk
'先使用（或仅）工作表存储结果
设置shtResult = .Worksheets（1）
'创建用于读取文本文件的临时工作表
设置shtSource = .Worksheets.Add
结束与
'将结果工作表命名为
'，并将搜索值指定为结果
与shtResult
.Cells（1，1）.Value = strValue
.name =Results
End with
'使用给定的路径进行文件搜索&扩展信息
strFile = Dir（strPath& strExt，vbNormal）
'Dir函数返回给定路径中给定扩展名的第一个文件名
'
'如果它是空字符串，那么这意味着不再有文件返回
Do Until strFile =
'通过在temp工作表中使用文件引用
'创建一个查询表缓冲区启动从单元格A1
设置data = shtSource.QueryTables.Add（Connection：=TEXT;& strPath& strFile，Destination：= shtSource.Cells（1，1））
'设置查询表导入属性
数据
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = F alse
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array（1）
.TextFileTrailingMinusNumbers = True
'最后从文件中检索数据
.Refresh BackgroundQuery ：= False
结束
'现在文件内容在临时工作表中作为行
'以单元格$ b $查找数据中的部分字符串b设置fndSection = data.ResultRange.Find（strSection）
如果不是fndSection是Nothing然后
'如果找到部分，则搜索值名称后找到部分
设置fndValue = data.ResultRange Find（strValue，fndSection）
如果不是fndValue是Nothing然后
'如果找到值名称，然后将其放入结果工作表
'中的下一个可用单元格中，通过删除值名称，因此它将是值本身
shtResult.Cells（sh tResult.Rows.Count，1）.End（xlUp）.Offset（1）.Value = Replace（fndValue，strValue，）
End If
End If
With data
'清除查询表范围
.ResultRange.Delete
'删除查询表，以便我们可以重新创建下一个文件
.Delete
End with
'搜索下一个文件满足给定的路径和扩展条件
strFile = Dir
循环
'删除临时工作表
'使其静默禁用关于删除工作表的应用程序警报
Application.DisplayAlerts = False
shtSource.Delete
'启用应用程序警报返回
Application.DisplayAlerts = True
结束Sub
享受VBA编程！
= ===============================
*编辑多个部分*
Sub ImportData（）
Dim wrk As Workbook
Dim shtSource As Worksheet
Dim shtResult As Worksheet
Dim rng As Range
Dim fndSection As Range
Dim fndNextSection As Range
Dim fndValue As范围
Dim数据作为QueryTable
Dim strFile
Dim strPath As String
Dim strExt As String
Dim strSection As String
Dim strSections
Dim strValue As String
Dim i As Integer
Dim indFileNames As Boolean
'========开始设置==== ====
'定义文件路径 - 注意有最后一个反斜杠
strPath =C：\Users\smozgur\Desktop\files\
'定义文件扩展名
strExt =* .txt
'要查找的部分
strSections = Array（Led 01 Intensity，_
Led 02 Intensity ，_
Led 03 Int
Led 04 Intensity$ _
Led 05 Intensity）
'单元格值在节后
strValue =MVA：
在输出中指定文件名？
indFileNames = True
'======== END SETTINGS ========
'创建一个新的工作簿不要乱使用现有的
设置wrk = Application.Workbooks.Add
使用wrk
'使用第一个（或仅）工作表来存储结果
设置shtResult = .Worksheets（1）
'创建用于读取文本文件的临时工作表
设置shtSource = .Worksheets.Add
结束
'命名结果工作表
'并放置部分标题以指示他们的列
与shtResult
与.Cells（1）.Resize（，UBound（strSections）+ 1）
.Value = strSections
.Resize（，UBound（strSections）+ 1）.Font.Bold = True
结束
如果indFileNames = True然后
带有.Cells（1，UBound（strSections）+ 3）
.Value =NOTES
.Font.Bold = True
End with
End If
.name =Results
End with
'使用给定信息进行文件搜索
strFile = Dir（strPath& strExt，vbNormal）
'Dir函数在给定路径
'中返回第一个文件名
'，如果为空字符串，则表示不再有文件返回
Do Until strFile =
'通过使用从单元格A1开始的临时工作表中的文件引用
'创建一个查询表缓冲区
设置data = shtSource.QueryTables .Add（Connection：=TEXT;& strPath& strFile，Destination：= shtSource.Cells（1，1））
'设置查询表导入属性
数据
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array（1）
.TextFileTrailingMinusNumbers = True
'最后从文件中检索数据
.Refresh BackgroundQuery：= False
End with
'现在文件内容是在temp工作表中作为行
'循环通过请求的部分
对于i = 0到UBound（strSections）
'查找部分数据中的字符串为Cell
设置fndSection = data.ResultRange.Find（strSections（i））
如果不是fndSection是Nothing然后
'如果找到部分，则搜索值名称AFTER找到的部分
设置fndValue = data.ResultRange.Find（strValue，fndSection）
如果不是fndValue是Nothing然后
'如果此部分中不存在值但找到下一个值在下一节
'我们必须避免除非我们确定每个部分必须具有值
如果i< UBound（strSections）然后
设置fndNextSection = data.ResultRange.Find（strSections（i + 1），fndSection）
Else
设置fndNextSection = shtSource.Cells（shtSource.Rows.Count）
End If
'结果工作表中的下一个可用单元格
设置rng = shtResult.Cells（shtResult.Rows.Count，i + 1）.End（xlUp）.Offset（ 1）
'只有使用该值，如果找到的值属于section
如果fndValue.Row< fndNextSection.Row然后
'如果找到值名称，然后将其放入结果工作表
'中的下一个可用单元格中，通过删除值名称，因此它将是值本身
rng.Value = Replace（fndValue，strValue，）
Else
rng.Value =N / A
End If
End If
End If
下一个我
如果indFileNames = True然后
'让我们指出哪个文件我们得到这个值
设置rng = shtResult.Cells（shtResult.Rows.Count，UBound（strSections）+ 3）.End（xlUp）.Offset（1）
rng.Value = strFile
如果
带有数据
'清除查询表范围
.ResultRange.Delete
'删除查询表，以便我们可以为下一个文件重新创建它
.Delete
结束
'搜索下一个文件符合给定的路径和扩展条件
strFile = Dir
循环
'结果工作表中的自动调整列
shtResult.Columns.AutoFit
'删除临时工作表
'使其静默禁用关于删除工作表的应用程序警报
Application.DisplayAlerts = False
shtSource.Delete
'启用应用程序提醒返回
Application.DisplayAlerts = True
End Sub
I might have a question about VBA and Excel Macros. The thing that I need to do is to import data (actually integer values) from multiple text files that have random generated names (for example 12345678.txt, 8654321.txt, etc.) but which are stored in the same folder (let's call it Data folder) to excel into a column.
The problem that I face is that I have the same name for the measured values (called MVA) that are repeating over and over in the text files. I don't need all the data from the text files, only some specific rows of these MVA (for the example below let's say that I need only the MVA number for the "LED 01 Intensity" which is 6250 to be stored in a new cell in Excel. And I need to get that value that comes after "LED 01 Intensity" in the MVA row from 10 multiple text files (with random names that I don't know) to be stored each one in separate cells in Excel (from A1 to A10).
Example_____________________________________________________________________
Name: 153588.txt
Date: 14.05.2016
Name of product: Electronic Device 01
CHECK TEST
Resistance 101
MVA: 2 Ohm
MAX: 5 Ohm
MIN: 0 Ohm
PASS
LED 01 Intensity
MVA: 6250
MAX: 10000
MIN: 5000
PASS
I need a lot of these MVA values to be stored in Excel for analysis and I need to get an idea if this problem can be solved with VBA. If you can offer me some help to create a macro for this I would be thankful (I have basic knowledge of programming but I'm a beginner in VBA).
Here is the code I promised for. It is actually not only sample but actual code that you need according the descriptions you provided.
Please note I wrote it according to the sample file you provided - means that it might fail with different text file structures.
You will notice there is a settings section at the beginning. That's where you setup what needs to be given to the code.
It won't be a big impact for only hundreds of text files for your system considering the sample file - perhaps will work and finish in seconds. However screen updating might be disabled in the code during the code execution. See ScreenUpdating property of Excel Application object if you notice a real big system slowness.
I am hoping to give you some good start for the VBA, so I tried to use many methods and commented a lot to explain what we are doing in each step. For example, using the first worksheet as results worksheet in the newly created workbook but creating a new worksheet for the temporary worksheet. There is a reason for this: every new workbook is created with at least one worksheet but it might be also the only one worksheet according to the Excel settings in that computer. However, even those part could be designed different by getting the number of the worksheets first and delete the unnecessary ones and keep only 2 then use those instead creating a new one.
Shortly - there are many different ways to accomplish the same task - like in many other programming languages. For example, I used QueryTable to import data into the worksheet then used Find method to find out if it has the values I needed. I didn't have to do this, I could have instead put the all information in a string variable and make the search in the string! Or by using another method, or another.
Finally this is supposed to be what you need. And I hope it gives you a good start. To make this code work: Create a new workbook -> goto VBA -> Use menu and Insert->Module -> Copy and paste the following code into the right pane opened in the editor. Change the necessary variables in the settings area at the beginning in the sub procedure (likely only the path variable) and hit F5 to run the code.
Sub ImportData()
Dim wrk As Workbook
Dim shtSource As Worksheet
Dim shtResult As Worksheet
Dim rng As Range
Dim fndSection As Range
Dim fndValue As Range
Dim data As QueryTable
Dim strFile
Dim strPath As String
Dim strExt As String
Dim strSection As String
Dim strValue As String
' ======== BEGIN SETTINGS ========
' Define the files path - note there is a last backslash
strPath = "C:\Users\smozgur\Desktop\files\"
' Define file extension
strExt = "*.txt"
' Section to be find
strSection = "Led 01 Intensity"
' Cell value to be find after section
strValue = "MVA:"
' ======== END SETTINGS ========
' Create a new workbook to not mess with existing
Set wrk = Application.Workbooks.Add
With wrk
' Use first (or only) worksheet to store results
Set shtResult = .Worksheets(1)
' Create temp worksheet for reading text files
Set shtSource = .Worksheets.Add
End With
' Name the Results worksheet
' and put search value to indicate it in results
With shtResult
.Cells(1, 1).Value = strValue
.name = "Results"
End With
' Make file search with the given path & extension information
strFile = Dir(strPath & strExt, vbNormal)
' Dir function returns the first file name
' with the given extension in the given path
' if it is empty string then it means "no more file returned"
Do Until strFile = ""
' Create a query table buffer by using the file reference
' in the temp worksheet starting from cell A1
Set data = shtSource.QueryTables.Add(Connection:="TEXT;" & strPath & strFile, Destination:=shtSource.Cells(1, 1))
' Set up query table import properties
With data
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
' Finally retrieve data from the file
.Refresh BackgroundQuery:=False
End With
' Now the file content is in the temp worksheet as rows
' Find the section string in the data as Cell
Set fndSection = data.ResultRange.Find(strSection)
If Not fndSection Is Nothing Then
' If section is found then search for the Value Name AFTER found section
Set fndValue = data.ResultRange.Find(strValue, fndSection)
If Not fndValue Is Nothing Then
' If Value Name is found then put it into the next available cell in Results worksheet
' by removing the Value Name, so it will be the value itself
shtResult.Cells(shtResult.Rows.Count, 1).End(xlUp).Offset(1).Value = Replace(fndValue, strValue, "")
End If
End If
With data
' Clear the query table range
.ResultRange.Delete
' Delete the query table so we can recreate it for the next file
.Delete
End With
' Search for the next file meets the given path and extension criteria
strFile = Dir
Loop
' Delete the temporary worksheet
' Make it silent disabling Application Alerts about deleting the worksheet
Application.DisplayAlerts = False
shtSource.Delete
' Enable Application Alerts back
Application.DisplayAlerts = True
End Sub
Enjoy VBA programming!
==================================
* EDIT FOR MULTIPLE SECTIONS *
Following code handles multiple sections in the source files.
Sub ImportData()
Dim wrk As Workbook
Dim shtSource As Worksheet
Dim shtResult As Worksheet
Dim rng As Range
Dim fndSection As Range
Dim fndNextSection As Range
Dim fndValue As Range
Dim data As QueryTable
Dim strFile
Dim strPath As String
Dim strExt As String
Dim strSection As String
Dim strSections
Dim strValue As String
Dim i As Integer
Dim indFileNames As Boolean
' ======== BEGIN SETTINGS ========
' Define the files path - note there is a last backslash
strPath = "C:\Users\smozgur\Desktop\files\"
' Define file extension
strExt = "*.txt"
' Sections to be find
strSections = Array("Led 01 Intensity", _
"Led 02 Intensity", _
"Led 03 Intensity", _
"Led 04 Intensity", _
"Led 05 Intensity")
' Cell value to be find after section
strValue = "MVA:"
' Indicate file names in the output?
indFileNames = True
' ======== END SETTINGS ========
' Create a new workbook to not mess with existing
Set wrk = Application.Workbooks.Add
With wrk
' Use first (or only) worksheet to store results
Set shtResult = .Worksheets(1)
' Create temp worksheet for reading text files
Set shtSource = .Worksheets.Add
End With
' Name the Results worksheet
' and put section headers to indicate their columns
With shtResult
With .Cells(1).Resize(, UBound(strSections) + 1)
.Value = strSections
.Resize(, UBound(strSections) + 1).Font.Bold = True
End With
If indFileNames = True Then
With .Cells(1, UBound(strSections) + 3)
.Value = "NOTES"
.Font.Bold = True
End With
End If
.name = "Results"
End With
' Make file search with given information
strFile = Dir(strPath & strExt, vbNormal)
' Dir function returns the first file name
' with the given extension in the given path
' if it is empty string then it means "no more file returned"
Do Until strFile = ""
' Create a query table buffer by using the file reference
' in the temp worksheet starting from cell A1
Set data = shtSource.QueryTables.Add(Connection:="TEXT;" & strPath & strFile, Destination:=shtSource.Cells(1, 1))
' Set up query table import properties
With data
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = False
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
' Finally retrieve data from the file
.Refresh BackgroundQuery:=False
End With
' Now the file content is in the temp worksheet as rows
' Loop through requested sections
For i = 0 To UBound(strSections)
' Find the section string in the data as Cell
Set fndSection = data.ResultRange.Find(strSections(i))
If Not fndSection Is Nothing Then
' If section is found then search for the Value Name AFTER found section
Set fndValue = data.ResultRange.Find(strValue, fndSection)
If Not fndValue Is Nothing Then
' What if value doesn't exist in this section but it finds the next value in the next section
' We have to avoid that unless we are certainly sure each section MUST have the value
If i < UBound(strSections) Then
Set fndNextSection = data.ResultRange.Find(strSections(i + 1), fndSection)
Else
Set fndNextSection = shtSource.Cells(shtSource.Rows.Count)
End If
' Next available cell in the Results worksheet
Set rng = shtResult.Cells(shtResult.Rows.Count, i + 1).End(xlUp).Offset(1)
' Only use the value if found value belongs to the section
If fndValue.Row < fndNextSection.Row Then
' If Value Name is found then put it into the next available cell in Results worksheet
' by removing the Value Name, so it will be the value itself
rng.Value = Replace(fndValue, strValue, "")
Else
rng.Value = "N/A"
End If
End If
End If
Next i
If indFileNames = True Then
' Let's indicate which file we got this values
Set rng = shtResult.Cells(shtResult.Rows.Count, UBound(strSections) + 3).End(xlUp).Offset(1)
rng.Value = strFile
End If
With data
' Clear the query table range
.ResultRange.Delete
' Delete the query table so we can recreate it for the next file
.Delete
End With
' Search for the next file meets the given path and extension criteria
strFile = Dir
Loop
' Autofit columns in the Results worksheet
shtResult.Columns.AutoFit
' Delete the temporary worksheet
' Make it silent disabling Application Alerts about deleting the worksheet
Application.DisplayAlerts = False
shtSource.Delete
' Enable Application Alerts back
Application.DisplayAlerts = True
End Sub
这篇关于将数据从多个文本文件导入Excel VBA的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！
