这是我承诺的代码。根据您提供的描述，它实际上不仅是示例代码，而且是您需要的实际代码。
请注意，我是根据您提供的示例文件编写的 - 这意味着它可能因不同的文本文件结构而失败。
您会注意到开头有一个设置部分。这就是您设置需要为代码提供的内容的地方。
考虑到示例文件，它不会对您的系统仅数百个文本文件产生重大影响 - 可能会在几秒钟内工作并完成。但是，在代码执行期间，可能会在代码中禁用屏幕更新。如果您发现系统确实非常缓慢，请参阅 Excel 应用程序对象的 ScreenUpdating 属性。
我希望能给你一个VBA一个好的开始，所以我尝试了很多方法并评论了很多来解释我们在每个步骤中所做的事情。例如，在新创建的工作簿中使用第一个工作表作为结果工作表，但为临时工作表创建一个新工作表。这是有原因的：每个新工作簿都是用至少一个工作表创建的，但根据该计算机中的 Excel 设置，它也可能是唯一的一个工作表。但是，即使是那些部分也可以通过首先获取工作表的数量并删除不必要的工作表并仅保留 2 个然后使用这些而不是创建一个新的来设计不同的部分。
简而言之 - 有许多不同的方法可以完成相同的任务 - 就像在许多其他编程语言中一样。例如，我使用 QueryTable 将数据导入工作表，然后使用 Find 方法找出它是否具有我需要的值。我不必这样做，我可以将所有信息放在字符串变量中并在字符串中进行搜索！或通过使用另一种方法，或另一种。
最后这应该是你所需要的。我希望它能给你一个好的开始。要使此代码工作：创建一个新工作簿 -> 转到 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 ========
' 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
享受 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 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