如何在 excel 中粘贴前导“0”的文本

How to paste text with leading "0" in excel

我有这段代码可以将整个 txt 文件内容粘贴到我的活动工作簿,但它在单元格中丢失了前导“0”:

Dim FileToOpen As Variant
Dim OpenBook As Workbook

FileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")

If FileToOpen <> False Then
Set OpenBook = Application.Workbooks.Open(FileToOpen)
OpenBook.Sheets(1).UsedRange.Select
Selection.NumberFormat = "@"
OpenBook.Sheets(1).UsedRange.Copy
ThisWorkbook.Worksheets("BOM").Range("C1").PasteSpecial xlPasteValues
OpenBook.Close False
End If

我试图通过添加

来解决这个问题
OpenBook.Sheets(1).UsedRange.Select
Selection.NumberFormat = "@"

但这并不能解决问题。

那么如何粘贴内容而不丢失前导“0”?

您可以尝试设置目标范围的格式。

Dim FileToOpen As Variant
Dim OpenBook As Workbook
Dim rng As Range

    FileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")

    If FileToOpen <> False Then
        Set OpenBook = Application.Workbooks.Open(FileToOpen)
        Set rng = OpenBook.Sheets(1).UsedRange
        With ThisWorkbook.Worksheets("BOM")
            .Range("C1").Resize(rng.Rows.Count, rng.Columns.Count).NumberFormat = "@"
            rng.Copy
            .Range("C1").PasteSpecial xlPasteValues
        End With
        OpenBook.Close False
    End If

您需要知道这些数字有多少位。例如,此代码使所有数字都具有 6 位数字,因此它会添加前导零,直到字符串的 len 为 6。

此外,它会将 1 列复制到另一列。

Sub test()
Dim MiMatriz As Variant
Dim i As Long
Dim ZZ As Long
ZZ = 1 'first row where data is going to be pasted

MiMatriz = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row).Value

For i = 1 To UBound(MiMatriz) Step 1
    MiMatriz(i, 1) = "'" & Format(MiMatriz(i, 1), "000000")
Next i

Range("C" & ZZ & ":C" & ZZ + UBound(MiMatriz) - 1) = MiMatriz

Erase MiMatriz

End Sub

如下图所示,A 列是原始数字,C 列是带前导零的数字。

您可以调整此代码以满足您的需要。

请尝试下一个代码。它将使用不同的方式打开文本文件。如果列数不是常量,代码会先对它们进行计数,然后构建一个数组,使文件可以根据需要打开:

Sub openAsTextTextFormat()
 Dim FileToOpen As Variant, arrTXT, nrCol As Long, arr(), i As Long
 Dim OpenBook As Workbook

 FileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")


 If FileToOpen <> False Then
    'Check the number of text file columns:
    arrTXT = Split(CreateObject("Scripting.FileSystemObject").OpenTextFile(FileToOpen, 1).ReadAll, vbLf)
    nrCol = UBound(Split(arrTXT(0), vbTab))
    '______________________________________
    ReDim arr(nrCol) 'redim the format array
    For i = 0 To nrCol
        arr(i) = Array(1, 2) 'fill the format array with variant for TEXT Format!
    Next

    Workbooks.OpenText FileName:=FileToOpen, origin:=932, startRow:=1, DataType:=xlDelimited, _
        other:=True, OtherChar:="|", FieldInfo:=arr()
    Set OpenBook = ActiveWorkbook
    Stop ' The code will stop here! Please, check if the text file has been open with the correct format.
    OpenBook.Sheets(1).UsedRange.Copy ThisWorkbook.Worksheets("BOM").Range("C1")
      
    OpenBook.Close False
 End If
End Sub

要执行您想要的操作,您不能打开 文件。您必须 IMPORT 文件。这样您就可以将数据指定为文本 ,然后 Excel 将其转换为数值。 一旦Excel将其转换为数字,仅靠格式化将无法恢复原始文本值

例如,要导入文件,请使用 Workbooks.OpenText 方法:

Application.Workbooks.OpenText _
    Filename:=FileToOpen, _
    DataType:=xlDelimited, _
    comma:=True, Tab:=False, semicolon:=False, Space:=False, other:=False, _
    fieldinfo:=Array(Array(1, xlTextFormat), Array(2, xlTextFormat))
    

然后你可以做一个简单的copy/paste操作,文本属性应该保持

例如:

ActiveSheet.UsedRange.Copy Destination:= 'your fully qualified destination

把它们放在一起,就像:

Option Explicit

Sub due()
Dim FileToOpen As Variant
Dim OpenBook As Workbook

FileToOpen = Application.GetOpenFilename("Text Files (*.txt), *.txt")

If FileToOpen <> False Then
    Application.Workbooks.OpenText _
        Filename:=FileToOpen, _
        DataType:=xlDelimited, _
        comma:=True, Tab:=False, semicolon:=False, Space:=False, other:=False, _
        fieldinfo:=Array(Array(1, xlTextFormat), Array(2, xlTextFormat))
        
ActiveSheet.UsedRange.Copy ThisWorkbook.Worksheets("BOM").Range("C1")
ActiveWorkbook.Close False
End If
End Sub

请注意,除了 General 之外,您需要在 FieldInfo 中为每个要解析的列提供一个数组参数,并且不需要为不存在的列提供参数。有关详细信息,请参阅有关 Workbooks.OpenText 方法的 Microsoft VBA 帮助。

原始 CSV

粘贴值