编辑

Question

我需要从文本文件中提取特定数据，并将其放置在已经准备好模板的Microsoft Excel中。

我的文本文件内容示例：

     (3space)    (2s)   (2s)         (3s)                 (18s)
[key]   0.00-34.00  sec  2.08 minute   526 km/sec                  auto   
[key]   0.00-34.00  sec  1.88 minute   474 Km/sec                  auto    
[key]   0.00-34.00  sec  1.49 minute   376 km/sec                  auto    
[key]   0.00-34.00  sec  1.25 minute   316 km/sec                  auto    
[key]   0.00-34.00  sec  3.05 minute   771 km/sec                  van  
[key]   0.00-34.00  sec  2.79 minute   705 km/sec                  van  
[key]   0.00-34.00  sec  2.83 minute   715 km/sec                  van  
[key]   0.00-34.00  sec  2.83 minute   716 km/sec                  van

和excel工作表模板如下：excel sheet is ready with headings,rows and columns 并且此模板将手动创建。

预期： 1..txt文件中具有 km / sec和自动的值应在第二列中列出

2。.txt文件中具有 km / sec和van 的值应在第三列

中列出

ex：这是预期模板的外观：template after the values entered

已添加：

当我想从3个文件中读取并将值放在单个模板中时： file1中的instance-1

文件2中的实例2

文件3中的实例3

对于实例1，我进行了以下更改：

 Const strFile = "C:\file1.txt"

        ' Row Array
    Dim vntFR As Variant: vntFR = Array(89, 89)
    ' Column Array
    Dim vntCC As Variant: vntCC = Array(2, 8)

想知道如何继续使用file2和file3

Answer 1

一种可能的方法是将文件I / O与Mid一起使用。这样的事情似乎对您的样本数据有效：

Sub sGetDistanceData(strFile As String)
    On Error GoTo E_Handle
    Dim intFile As Integer
    Dim strInput As String
    Dim lngVan As Long
    Dim lngAuto As Long
    intFile = FreeFile
    Open strFile For Input As intFile
    lngVan = 6    ' the first row of van data
    lngAuto = 6    ' the first row of auto data
    Do
        Line Input #intFile, strInput
        If Mid(strInput, 68, 4) = "auto" Then
            ActiveSheet.Cells(lngAuto, 2) = Mid(strInput, 38, 5)
            lngAuto = lngAuto + 1
        ElseIf Mid(strInput, 68, 3) = "van" Then
            ActiveSheet.Cells(lngVan, 3) = Mid(strInput, 38, 5)
            lngVan = lngVan + 1
        End If
    Loop Until EOF(intFile)
sExit:
    On Error Resume Next
    Reset
    Exit Sub
E_Handle:
    MsgBox Err.Description & vbCrLf & vbCrLf & "sGetDistanceData", vbOKOnly + vbCritical, "Error: " & Err.Number
    Resume sExit
End Sub

为避免万一数据不相等，我对导入的Van / Auto数据的数量进行了单独计数。

此致

Answer 2

文本文件中的数据

Sub DataFromTextFile()

    ' Text File Address
    Const strFile = "C:\Test1.txt"
    Const cCriteria As Long = 67  ' Criteria Position
    Const cPosition As Long = 38  ' Target Position
    Const cChars As Long = 5      ' Target Chars

    ' Criteria Array
    Dim vntC As Variant: vntC = Array("auto", "van")
    ' Row Array
    Dim vntFR As Variant: vntFR = Array(6, 6)
    ' Column Array
    Dim vntCC As Variant: vntCC = Array(2, 3)

    Dim vntL As Variant           ' Criteria Length Array
    Dim vntR As Variant           ' Target Row Counter Array
    Dim LB As Long                ' Array Lower Bound
    Dim UB As Long                ' Array Upper Bound
    Dim i As Long                 ' Array Element Counter
    Dim t As Long                 ' Total Records Counter
    Dim lngFile As Long           ' Text File Number
    Dim strLine As String         ' Current Line (in Text File)

    ' Calculate Lower and Upper Bounds.
    LB = LBound(vntC): UB = UBound(vntC)

    ' Resize Criteria Length Array to the size of Criteria Array.
    ReDim vntL(UB) As Long
    ' Calulate the length of each element in Criteria Array and write
    ' the calculated values to Criteria Length Array.
    For i = LB To UB: vntL(i) = Len(vntC(i)): Next i
    ' Resize Target Row Counter Array to the size of Criteria Array.
    ReDim vntR(UB) As Long

    ' Aquire Text File Number.
    lngFile = FreeFile()          '

    ' Write Text File to memory.
    Open strFile For Input As #lngFile
        ' Loop through lines of Text File.
        Do While Not EOF(lngFile)
            ' Write current line of Text File (from memory) to Current Line.
            Line Input #lngFile, strLine
            ' Loop through elements of Arrays.
            For i = LB To UB
                ' Check if Current Criteria is found at current Target Position.
                If Mid(strLine, cCriteria, vntL(i)) = vntC(i) Then
                    ' Count Target Row by increasing the current value
                    ' of the current element in Target Row Counter Array.
                    vntR(i) = vntR(i) + 1
                    ' Write Current Target Value to ActiveSheet.
                    Cells(vntFR(i) + vntR(i) - 1, vntCC(i)) _
                      = Trim(Mid(strLine, cPosition, cChars))
                    ' Count Total (All) Records so far.
                    t = t + 1
                    Exit For
                End If
            Next i
        Loop
    Close #1

    MsgBox "Total Records Found: " & t, vbInformation

End Sub

所有这些数组都不是为了提高速度，而是为了能够轻松更改变量的值，或更重要的是添加更多标准值，例如：

' Criteria Array
Dim vntC As Variant: vntC = Array("auto", "van", "bike", "plane")
' Row Array
Dim vntFR As Variant: vntFR = Array(6, 6, 6, 6)
' Column Array
Dim vntCC As Variant: vntCC = Array(2, 3, 4, 5)

编辑

此版本由DataFromText组成，您可以在其中分别更改文本文件和列对的名称，以及新版本的DataFromTextFile 我已经按照要求将行号更改为89。最好重命名或删除旧版本的DataFromTextFile。

Option Explicit

Sub DataFromText()

    Dim vntFiles As Variant   ' Files Array
    Dim i As Long             ' Arrays Elements Counter

    ' Files
    vntFiles = Array("C:\Test1.txt", "C:\Test2.txt", "C:\Test3.txt")
    ' If you add more files, you have to add more column pairs and increase
    ' the ubound of vntColumns i.e. the number in braces.
    Dim vntColumns(2) As Variant

    ' Column Pairs
    vntColumns(0) = Array(2, 8)
    vntColumns(1) = Array(3, 9)
    vntColumns(2) = Array(4, 10)

    For i = 0 To UBound(vntFiles)
        DataFromTextFile CStr(vntFiles(i)), vntColumns(i)
    Next i

End Sub

Sub DataFromTextFile(FilePath As String, TargetColumns As Variant)

    ' Text File Address
    Dim strFile As String
    strFile = FilePath
    Const cCriteria As Long = 67  ' Criteria Position
    Const cPosition As Long = 38  ' Target Position
    Const cChars As Long = 5      ' Target Chars

    ' Criteria Array
    Dim vntC As Variant: vntC = Array("auto", "van")
    ' Row Array
    Dim vntFR As Variant: vntFR = Array(89, 89)
    ' Column Array
    Dim vntCC As Variant: vntCC = TargetColumns

    Dim vntL As Variant           ' Criteria Length Array
    Dim vntR As Variant           ' Target Row Counter Array
    Dim LB As Long                ' Array Lower Bound
    Dim UB As Long                ' Array Upper Bound
    Dim i As Long                 ' Array Element Counter
    Dim t As Long                 ' Total Records Counter
    Dim lngFile As Long           ' Text File Number
    Dim strLine As String         ' Current Line (in Text File)

    ' Calculate Lower and Upper Bounds.
    LB = LBound(vntC): UB = UBound(vntC)

    ' Resize Criteria Length Array to the size of Criteria Array.
    ReDim vntL(UB) As Long
    ' Calulate the length of each element in Criteria Array and write
    ' the calculated values to Criteria Length Array.
    For i = LB To UB: vntL(i) = Len(vntC(i)): Next i
    ' Resize Target Row Counter Array to the size of Criteria Array.
    ReDim vntR(UB) As Long

    ' Aquire Text File Number.
    lngFile = FreeFile()          '

    ' Write Text File to memory.
    Open strFile For Input As #lngFile
        ' Loop through lines of Text File.
        Do While Not EOF(lngFile)
            ' Write current line of Text File (from memory) to Current Line.
            Line Input #lngFile, strLine
            ' Loop through elements of Arrays.
            For i = LB To UB
                ' Check if Current Criteria is found at current Target Position.
                If Mid(strLine, cCriteria, vntL(i)) = vntC(i) Then
                    ' Count Target Row by increasing the current value
                    ' of the current element in Target Row Counter Array.
                    vntR(i) = vntR(i) + 1
                    ' Write Current Target Value to ActiveSheet.
                    Cells(vntFR(i) + vntR(i) - 1, vntCC(i)) _
                      = Trim(Mid(strLine, cPosition, cChars))
                    ' Count Total (All) Records so far.
                    t = t + 1
                    Exit For
                End If
            Next i
        Loop
    Close #1

    MsgBox "Total Records Found: " & t, vbInformation

End Sub

从.txt文件中提取特定值并将其放在excel中

2 个答案:

文本文件中的数据

编辑