不放置零

我有一個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

uj5u.com熱心網友回復：

匯入文本檔案

• Workbook.OpenText 方法(Microsoft Docs)
• 特別注意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:\Test\2021\70386358\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

標籤：擅长 vba 复制粘贴 粘贴

上一篇：如何在VBA中自動向下填充列

下一篇：VBA-在msgbox之后回傳用戶表單