使用vba在excel中复制带有前导零的数字文本

Posted 2023-03-06

【中文标题】使用vba在excel中复制带有前导零的数字文本

【英文标题】：Copying numeric text with leading zeroes in excel using vba

【发布时间】：2014-06-07 13:30:58

【问题描述】：

我编写了一个宏来获取 Excel 工作表的内容并将它们导出到 CSV 文件（供其他应用程序导入）。

我的问题是，在导出时，任何包含可以解释为数字的文本的单元格都会转换为数字。这意味着如果文本包含前导零，这些零就会丢失。

所以，这样的数据：

资产 0100738 1/05/2003 612

将导出为

资产,100738,1/05/2003,612

我的代码是：

Public Sub ExportSheetAsCSV(ByRef sh As Worksheet)
    Dim dataToExport As Excel.Range
    Dim newWrkbk As Excel.Workbook
    Dim FSO As New FileSystemObject
    Dim dstdir As String
    Dim dstpath As String

    Set dataToExport = sh.UsedRange
    Set newWrkbk = newWorkbook(1, ActiveWorkbook)
    '' Copy Step:
    newWrkbk.Sheets("Sheet1").Range("A1").Resize(dataToExport.Rows.Count, dataToExport.Columns.Count).Value = dataToExport.Value

    dstdir = FSO.BuildPath(FSO.BuildPath(ActiveWorkbook.path, "CSVs"), FSO.GetBaseName(ActiveWorkbook.Name))
    dstpath = FSO.BuildPath(dstdir, sh.Name & ".csv")

    MkDirStructure dstdir

    newWrkbk.SaveAs Filename:=dstpath, FileFormat:=xlCSV, CreateBackup:=False, Local:=True
    newWrkbk.Close False
End Sub

通过逐步完成此操作，我可以看到前导零在复制步骤（与保存步骤相反）消失了。

这个问题，VBA: preceding zeros dropped when copied over，涵盖了一个类似的问题，但没有一个给定的答案对我有用。接受的答案是将有问题的单元格转换为文本（另一个最佳答案是使用 VBA 的 numberFormat 做同样的事情），但是

我事先不知道需要转换哪些单元格，所以很不方便 单元格的值由公式更新，因此如果我转换为文本，则公式的文本将成为单元格的值 日期值将转换为其整数表示形式 这甚至不起作用。将单元格转换为文本后，前导零仍会被去除。

有人能解决这个问题吗？

谢谢

【参考方案1】：

' 将所有单元格的格式转换为文本并为所需的单元格范围添加以下行...在复制数据之前...

Range("B1:X100000").NumberFormat = "@"

【讨论】：

您好 bp696，感谢您的回复。这与这里的第二个答案相同，***.com/questions/493780/… 对我不起作用。再看一遍，我想我误解了那个答案，还有你的。我曾尝试在要复制的范围上使用 .NumberFormat = "@" ，但这并没有解决问题。如果我重新格式化要复制的范围，则可以解决前导零问题。您能否确认您的意思是将目标范围而不是源范围重新格式化为文本？

但是，使用此解决方案会导致日期从 dd/mm/yyyy 重新格式化为 mm/dd/yyyy 的问题，这会导致其他问题。

@tensorproduct 我的意思是目标范围......您可以选择日期列之外的范围并将它们转换为文本......

恐怕我打算在各种电子表格上使用这个宏，而不知道日期列可能提前在哪里（而且在许多情况下，日期不会被整齐地限制在单个列中)。

【参考方案2】：

好的，经过更多的工作，我找到的解决方法是进行复制/粘贴特殊，而不是将目标范围的值分配给源的值。

所以，这一行：

newWrkbk.Sheets("Sheet1").Range("A1").Resize(dataToExport.Rows.Count, dataToExport.Columns.Count).Value = dataToExport.Value

被替换为

Application.CutCopyMode = False
Set oldWrkbk = ActiveWorkbook

dataToExport.Copy
newWrkbk.Sheets("Sheet1").Activate
Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
    xlNone, SkipBlanks:=False, Transpose:=False
oldWrkbk.Activate

缓存对源工作簿的引用，以便我们可以在关闭新文件之前返回到开始的位置。