使用 VBA 在 excel 中导入特定文本的过程

Question

我正在尝试将许多 table 导入 excel（选择了固定宽度选项），我希望它将其作为“i”的函数粘贴到某些区域，见下文： For i = 0 to X

我希望“X”是从文本文件中导入的 table 的数量，我认为这里可以使用 Count 函数，但我不确定如何使用

到目前为止，我已经编写了这段代码，但我不确定我在某些命令后发布的推荐的语法是什么：

Sub ImportLPileTextFile()
    Dim myFile As String, text As String, textline As String, pos1 As Integer, pos2 As Integer

    myFile = Application.GetOpenFilename()
        
    Open myFile For Input As #1
        
    Do Until EOF(1)
        Line Input #1, textline
        text = text & textline
    Loop
    Close #1
        
    pos1 = InStr(text, "   y, inches ")
    pos2 = InStr(text, "000         ") 'I'm using the zero values after the decimal becuase the end text is sometimes different
                                       'can I set this second condition to be "if two blank lines appear" somehow?
                                       'There are a minimum of 2 open spaces after the table ends. See photo

     For i = 0 To 'Count(how many items are pasted)
     
         Range(.Cells(8, 3 * i + 1)).Value = Mid(text, pos1 + 0, 0) ' is 0 right? I want to include this in what I want copied, see photo example
         'How do i paste this table as a special paste with "Fixed width" option?
                
     Next i
End Sub

我知道 i = 0 to ... 循环不在正确的区域，对于 Do Until 它需要在 Loop 之前？对吗？

下面是两张图片：

文件粘贴到我的 ActiveSheet 后的样子。我在图像中放置了注释以显示我的 i = 0 to ... 函数的用途。请注意“在下面粘贴数据...”是我希望粘贴数据的地方。
我需要从中提取的实际文本文件和确切数据：

根据 Tim 的要求，带有段落选项的文本文件的 Word 版本显示了所有缩进。左边显示第一个 table 的外观，第二个显示第二个和其余 table 的外观。最坏的情况是，它们上面总是有“y,inches p,lbs.in”，所以我总是可以用它作为要查找的第一个字符串，我不一定非要在我的excel，我可以手动输入，实际的数字就是复制的数据。

当我从文本文件复制并使用“固定宽度”选项将特殊内容粘贴到 excel 时，它会完美地粘贴两列，如上图 excel 所示。

在此先感谢您抽出时间查看本文并给我建议和指导。

Answer 1

这对我有用 - 你可能需要稍微调整一下才能让一切都去你想要的地方。

Sub ImportLPileTextFile()
    Dim colTables As Collection, tbl As Collection, cDest As Range
    Dim ws As Worksheet, rw, n As Long, fName As String
    
    Set ws = ActiveSheet        'or whatever
    Set cDest = ws.Range("A8")  'tables start here
    
    fName = Application.GetOpenFilename()
    If Len(fName) = 0 Then Exit Sub
    
    Set colTables = GetFileData(fName) 'read the file
    Debug.Print "Found " & colTables.Count & " tables"
    
    For Each tbl In colTables
        n = 0
        'write the header
        cDest.Resize(1, 2).Value = Array("y, inches", "p, lbs/in")
        For Each rw In tbl                           'loop all rows
            n = n + 1                                'next output line down
            cDest.Offset(n).Resize(1, 2).Value = rw  'write a row
        Next rw
        Set cDest = cDest.Offset(0, 3) 'next table output start cell
    Next tbl
End Sub

'Given a file path, return a collection of collections, where each contained
'  collection rpresents one table, and is a set of arrays of (yvalue, p value)
'  representing "rows" in that table
Function GetFileData(fPath As String)
    Dim colTables As New Collection, fso As Object, f As Object, txt
    Dim inTable As Boolean, tbl As Collection, iBlank As Long, y, p
    
    Set fso = CreateObject("scripting.filesystemobject")
    Set f = fso.opentextfile(fPath, 1) 'for reading
    Do Until f.AtEndOfStream
        txt = f.readline()
        iBlank = IIf(Len(txt) = 0, iBlank + 1, 0) 'counting consecutive blank lines
        
        'start of a table?
        If txt Like "*y, inches*p, lbs/in*" Then
            Set tbl = New Collection  'start a new collection for rows
            inTable = True            'set flag
        Else
            If inTable Then
                If Len(txt) > 20 Then  'have some data?
                    'skip the "------" header
                    If Not txt Like "*----*" Then
                        y = Trim(Left(txt, 14))
                        p = Trim(Mid(txt, 15))
                        'if y and p are numeric then add as a "line"
                        If IsNumeric(y) And IsNumeric(p) Then
                            tbl.Add Array(CDbl(y), CDbl(p))
                        End If
                    End If
                Else
                    If iBlank >= 2 Then
                        'done with this table
                        inTable = False    'reset flag
                        colTables.Add tbl  'add this table to the return collection
                    End If 'two consecutive blank lines
                End If
            End If
        End If
    Loop
    Set GetFileData = colTables
End Function

使用 VBA 在 excel 中导入特定文本的过程

Process to Import specific text in excel with VBA

excel

vba