使用 VBA 在 excel 中導入特定文本的過程

Question

我正在嘗試將許多表導入到 excel 中（選擇了固定寬度選項），我希望它作為“i”的函數將其粘貼到某些區域，見下文： For i = 0 to X

我希望“X”是從文本文件導入的表數，我認為可以在這里使用 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 ...循環不在正確的區域，它需要在Loop for Do Until ？ 正確的？

下面是兩張圖片：

1. 文件粘貼到我的ActiveSheet后的樣子。 我在圖像中放置了注釋以顯示我的i = 0 to ...函數的用途。 請注意“下面的粘貼數據......”是我想要粘貼數據的地方。

2. 實際的文本文件和我需要從中提取的確切數據：

3. 文本文件的 Word 版本，帶有段落選項，根據 Tim 的要求顯示所有縮進。 左邊顯示第一個表的外觀，第二個是第二個和其余表的外觀。 最壞的情況，它們上面總是有“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