将 Excel 电子表格中的 TXT 文件导入特定单元格

Question

我有一个问题，我想将 TXT 文件导入 Excel 但需要始终将文件的一部分粘贴到某个单元格中，因为所有其他代码都基于该原始单元格位置。 我想修改我的 VBA 代码以考虑到这种灵活性。

下面是一张展示理想场景的图片：以黄色突出显示的行位于单元格 A47 内。 所有 TXT 文件都将采用类似的格式，因此应始终将此行粘贴在此标题中。 随后的表格将被放置在后续代码的正确位置。

但是，大多数情况下，TXT 文件的大小不同，因此该行不会在 A47 中。 下面是一个例子：

以米色突出显示的部分是根据文本文件大小而变化的部分，因此是问题的根源，因为它将 TXT 文件的 rest 向下推。 不过，米色部分并不重要，因此如果可以以某种方式将其删除/缩短到正确的大小并且下面的文本转移到单元格 A47，这将是这里的目标。 此代码需要适用于任何大小。

这是我必须导入 txt 文件的代码：

Sub Get_Data_From_File()
'Code to prompt the user to select a file (e.g. .TXT) and paste it in the Excel Worksheet

    Dim FiletoOpen As Variant
    Dim OpenBook As Workbook
    
    'In place to prevent the popup warning dialog box about having too much information on the clipboard as well as screen updating
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False
    
    'Prompting and Opening file for user
    FiletoOpen = Application.GetOpenFilename(Title:="Browse for your File & Import")
    If FiletoOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FiletoOpen)
        OpenBook.Sheets(1).Range("A1:AA1000").Copy
        ThisWorkbook.Worksheets("ImportTXT").Range("A5").PasteSpecial xlPasteValues
        OpenBook.Close False
           
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

先感谢您！

Answer 1

尝试，

Sub Get_Data_From_File2()
'Code to prompt the user to select a file (e.g. .TXT) and paste it in the Excel Worksheet

    Dim FiletoOpen As Variant
    Dim OpenBook As Workbook
    Dim Target As Range, rngDB As Range
    Dim Ws As Worksheet
    Dim Wb As Workbook
    Dim r As Integer
    
    Set Wb = ThisWorkbook
    Set Ws = Wb.Sheets("ImportTXT")

    'In place to prevent the popup warning dialog box about having too much information on the clipboard as well as screen updating
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    'Prompting and Opening file for user
    FiletoOpen = Application.GetOpenFilename(Title:="Browse for your File & Import")
    If FiletoOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FiletoOpen)
        OpenBook.Sheets(1).Range("A1:AA1000").Copy
        ThisWorkbook.Worksheets("ImportTXT").Range("A5").PasteSpecial xlPasteValues
        OpenBook.Close False

    End If

    Set Target = Ws.Range("a42")
    Set rngDB = Target.CurrentRegion
    r = rngDB.Rows.Count
    If r > 2 Then
        Set rngDB = Target(3).Resize(r - 2)
        rngDB.EntireRow.Delete
    End If
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub