我可能对VBA和Excel宏有疑问。我需要做的是从具有随机生成名称的多个文本文件（例如12345678.txt，8654321.txt等）导入数据（实际上是整数值）但存储在同一文件夹中（让我们调用）它数据文件夹）excel成一列。
我面临的问题是我在测量值（称为MVA）中具有相同的名称，这些值在文本文件中反复重复。我不需要文本文件中的所有数据，只需要这些MVA中的一些特定行（以下示例中，我们只需要将“LED 01 Intensity”的MVA编号为6250存储在新的中Excel中的单元格。我需要在10个多个文本文件（我不知道的随机名称）的MVA行中的“LED 01 Intensity”之后获取该值，将每个文件存储在Excel中的单独单元格中（从A1到A10）。
实施例_____________________________________________________________________
姓名：153588.txt
日期：2016年5月14日
产品名称：电子设备01
检查测试
抵抗101
MVA：2欧姆MAX：5欧姆
MIN：0欧姆
PASS
LED 01强度
MVA：6250
MAX：10000
MIN：5000
PASS
我需要将大量这些MVA值存储在Excel中进行分析，我需要了解是否可以使用VBA解决此问题。如果你能为我提供一些帮助来为此创建一个宏，我会很感激（我对编程有基本的了解，但我是VBA的初学者）。
答案 0 :(得分：1)
这是我承诺的代码。实际上，根据您提供的说明，您不仅需要样本，还需要实际代码。
请注意我是根据您提供的示例文件编写的 - 意味着可能使用不同的文本文件结构失败。
您会注意到开头有设置部分。您可以在其中设置需要为代码提供的内容。
考虑到样本文件，它不会对您的系统只有数百个文本文件产生重大影响 - 可能会在几秒钟内完成工作并完成。但是，在代码执行期间，代码中可能会禁用屏幕更新。如果您发现系统真正的系统速度很慢，请参阅Excel Application对象的ScreenUpdating属性。
我希望为VBA提供一些良好的开端，所以我尝试使用很多方法并进行了很多评论来解释我们在每一步中做了些什么。例如，使用第一个工作表作为新创建的工作簿中的结果工作表，但为临时工作表创建新工作表。这是有原因的：每个新工作簿都是使用至少一个工作表创建的，但根据该计算机中的Excel设置，它可能也是唯一一个工作表。然而，即使这些部分可以通过首先获取工作表的数量并删除不必要的部分来设计不同，然后只保留2，然后使用它们而不是创建新部分。
很快 - 有许多不同的方法可以完成相同的任务 - 就像许多其他编程语言一样。例如，我使用QueryTable将数据导入工作表，然后使用Find方法查明它是否具有我需要的值。我没有必要这样做，我可以将所有信息放在一个字符串变量中，并在字符串中进行搜索！或者使用其他方法或其他方法。
最后这应该是你需要的。我希望它能给你一个良好的开端。要使此代码有效：创建一个新工作簿 - ＆gt;转到VBA - ＆gt;使用菜单和插入 - ＆gt;模块 - ＆gt;将以下代码复制并粘贴到编辑器中打开的右窗格中。在子过程的开头更改设置区域中的必要变量（可能只是路径变量）并按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