不放置零

Question

我有一个 TXT file，但是当我将它插入我的 Excel 时，它正在删除 zeros 我不知道为什么会这样，我试着把字段类型 TEXT（但它会将其改回一般）并且在我的宏中放置 xlPasteValuesAndNumberFormats.

  Sub Get_Data_FromFile()
    Dim FileToOpen As Variant
    Dim OpenBook As Workbook
    
    Application.ScreenUpdating = False
    
    FileToOpen = Application.GetOpenFilename(Title:="Browser for your file & Import range", FileFilter:="Text Files (*.txt), *txt*")
    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        OpenBook.Sheets(1).Range("A1:U1000").Copy
        ThisWorkbook.Worksheets("Asiento único").Range("E18").PasteSpecial xlPasteValuesAndNumberFormats
        OpenBook.Close False
        
    End If
    
    Application.ScreenUpdating = True
    
End Sub

Answer 1

导入文本文件

Workbook.OpenText method（微软文档）
特别注意 Origin 和 FielInfo 参数。

Option Explicit

Sub ImportTextFile()
    
    Const sfRow As Long = 1
    
    Const dName As String = "Asiento único"
    Const dFirstCell As String = "E18"
    Const Cols As String = "A:U"
    
    Dim msgString As String
    Dim IsSuccess As Variant
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook
    Dim dws As Worksheet: Set dws = dwb.Worksheets(dName)
    Dim dfCell As Range: Set dfCell = dws.Range(dFirstCell)
    
    ' Create the FieldInfo parameter (all columns as text)
    Dim dcrg As Range: Set dcrg = dws.Columns(Cols)
    Dim dfCol As Long: dfCol = dcrg.Columns(1).Column
    Dim dlCol As Long: dlCol = dcrg.Columns(dcrg.Columns.Count).Column
    Dim cArr As Variant: ReDim cArr(0 To dlCol - dfCol)
    Dim c As Long
    For c = dfCol To dlCol
        cArr(c - dfCol) = Array(c, xlTextFormat)
    Next c
    
    Application.ScreenUpdating = False
    
    Dim FileToOpen As Variant
    FileToOpen = Application.GetOpenFilename( _
        Title:="Browser for your file & Import range", _
        FileFilter:="Text Files (*.txt), *txt*")

    If FileToOpen <> False Then
        
        Workbooks.OpenText _
            Filename:="C:\Test21386358\Test.txt", _
            Origin:=xlWindows, _
            StartRow:=sfRow, _
            DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, _
            ConsecutiveDelimiter:=False, _
            Tab:=True, _
            FieldInfo:=cArr
        
        Dim swb As Workbook: Set swb = ActiveWorkbook
        Dim sws As Worksheet: Set sws = swb.Worksheets(1)
        Dim srg As Range: Set srg = Intersect(sws.UsedRange, sws.Columns(Cols))
        
        msgString = "Copied from" & vbLf & srg.Address(0, 0, , True) & vbLf
        
        srg.Copy
        dfCell.PasteSpecial xlPasteValuesAndNumberFormats
        swb.Close SaveChanges:=False
        
        dws.Activate
        msgString = msgString & "to" & vbLf _
            & ActiveWindow.Selection.Address(0, 0, , True)
        dfCell.Select

        IsSuccess = True
         
    End If
    
    Application.ScreenUpdating = True
    
    If IsSuccess Then
        MsgBox msgString, vbInformation
    Else
        MsgBox "You canceled.", vbExclamation
    End If
    
End Sub

不放置零

Not placing the zeros

excel

vba

copy-paste

paste

导入文本文件