Excel VBA撇号在复制时消失

我正在重新编写一个宏，处理无法强制转换为科学符号的长整数（想想产品ID号）。在正常情况下，我只会将它们转换为字符串，但Excel似乎仍然将数字视为数字，即使分类为文本

因此，在使用以下代码更改任何其他内容之前，我必须在整个列中添加一个撇号：

Function CleanColumn(Col As String, ws As Worksheet, Optional wb As Workbook)
    If wb Is Nothing Then Set wb = ThisWorkbook
    With ws
        arr = .Range(.Cells(2, Col), .Cells(.Rows.Count, Col).End(xlUp)).Value2
        For i = LBound(arr, 1) To UBound(arr, 1)
            arr(i, 1) = Chr(39) & Replace(arr(i, 1), Chr(45), vbNullString)
        Next i
        .Cells(2, Col).Resize(UBound(arr, 1), UBound(arr, 2)) = arr
    End With
End Function

这很好，但是我现在需要获取数据集，并根据一列的值将其划分为单独的工作表。为此，我使用了以下方法：

Function CopyByCriteria(Criteria As String, FilterRange As Range, SourceSheet As Worksheet, DestinationSheet As Worksheet)
    Dim pasteRow As Integer
    Dim c As Range

    pasteRow = 1

    For Each c In FilterRange
        If c = Criteria Then
            DestinationSheet.Rows(pasteRow) = SourceSheet.Rows(c.Row).Value2
            pasteRow = pasteRow + 1
        End If
    Next c
End Function

问题是，当我使用CopyByCriteria函数时，我添加的撇号不会出现在新的工作表中，数字会变成科学符号

---

这个问题的解决方案是什么？

编辑：撇号实际上不是单元格公式/值的一部分。它存储在PrefixCharacter属性中（您可以使用即时窗口中的

？ActiveCell.PrefixCharacter

访问它）。 资料来源：

要100%确保复制此字符，必须复制值/公式和PrefixCharacter。但这不可能一次对整排人都这样

下面的代码可能工作，但可能不工作（对我来说，它工作了，但没有特殊原因很快停止工作）

---

为了100%确定，我建议使用Range.Copy方法或手动复制（就像OP对Value所做的那样）行中每个单元格的公式和PrefixCharacter。也许我会在有时间的时候为它提供代码。

会

目的表行（粘贴行）=Chr（45）和SourceSheet.Rows（c.Row）。Value2

改变这种行为吗？SourceSheet.Rows（c.Row）。Value2的值和类型是什么，他们也切换到scientific了吗？@jsheeran-c。行本身就是要粘贴的行号。每行由45列组成，这些列是字符串、百分比、货币和日期的组合，在

DestinationSheet.Rows（pasterrow）=SourceSheet.Rows（c.row）.Value2

您可以尝试

DestinationSheet.Rows（pasterrow）.numberformat=SourceSheet.Rows（c.row）.numberformat

@MKaras-这是撇号的有趣之处；我不知道它被当作一个函数来处理，但考虑到它是如何计算的，这是很有意义的。也就是说，您的解决方案中出现了类型不匹配错误。我想这是因为我复制的是一行而不是一个单元格。我的错。固定的。完美的解决方案。谢谢这对我来说已经不起作用了，所以我做了更多的研究，并用研究结果编辑了我的答案。

Function CopyByCriteria(Criteria As String, FilterRange As Range, SourceSheet As 
Worksheet, DestinationSheet As Worksheet)
    Dim pasteRow As Integer
    Dim c As Range

    pasteRow = 1

    For Each c In FilterRange
        If c = Criteria Then
            DestinationSheet.Rows(pasteRow).formula = SourceSheet.Rows(c.Row).formula
            pasteRow = pasteRow + 1
        End If
    Next c
End Function