从多个文本文件导入Excel中的数据VBA

Question

我可能有一个关于VBA和Excel宏的问题。我需要做的是从具有随机生成名称的多个文本文件（例如12345678.txt，8654321.txt等）中导入数据（实际上是整数值），但它们存储在同一文件夹中（让我们打电话给我们它的数据文件夹）擅长到一列。

我面对的问题是，我对测量值（称为MVA）具有相同的名称，这些名称在文本文件中反复重复。我不需要文本文件中的所有数据，只有这些MVA的一些特定行（对于下面的例子，假设我只需要用于6250的“LED 01强度”的MVA编号存储在新的我需要从10个多个文本文件（带有我不知道的随机名称）中将MVA行中的“LED 01 Intensity”之后的值分别存储在Excel中的单独单元格中从A1到A10）

Example_____________________________________________________________________

名称：153588.txt

日期：2016年5月14日

产品名称：电子设备01

CHECK TEST

电阻101

MVA：2欧姆

MAX：5欧姆

MIN：0欧姆

PASS

LED 0 1强度

MVA：6250

MAX：10000

MIN：5000

PASS

---

我需要很多这样的MVA值存储在Excel中进行分析如果VBA可以解决这个问题，我需要了解一下。如果你能为我提供一些帮助来创建一个宏，我会感激（我有编程的基本知识，但我是VBA的初学者）。

Answer 1

这是我承诺的代码。它实际上不仅是样本，而且还有实际您需要的代码根据您提供的描述。

请注意我根据您提供的示例文件编写它 - 意味着它可能可能失败，具有不同的文本文件结构。

你会注意到有一个设置部分在开始。这就是你设置需要给代码的地方。

考虑到示例文件，它对于系统只有数百个文本文件不会产生太大影响 - 可能会在几秒钟内完成并完成。但是，在代码执行过程中，屏幕更新可能会在代码中被禁用。如果您发现真正的大系统缓慢，请参阅Excel应用程序对象的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 ======== 
    ' 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