Question

我正在尝试创建一个VBA模板，该模板可用于将所有数据值抑制在一定数量以下。我已经找到/更新了一些在网上找到的代码，这些代码确实成功创建了新工作表，传输了所选数据，并根据需要用“ <30”替换了所有数字值30以下。但是，它还会更新原始数据源，替换选定的数据，而不仅仅是更新新工作表上的数据。如何防止它修改原始数据并仅修改复制到新工作表的数据？

我在这里尝试过这段代码，但是没有得到想要的结果，并且无法弄清楚如何对其进行修改以实现它们：

Sub SuppressLessThan()

Dim Rng As Range
Dim WorkRng As Range
Dim ws As Worksheet

On Error Resume Next

    Set WorkRng = Application.Selection
    Set WorkRng = Application.InputBox("Select the cells you are working with:", "Select Range", WorkRng.Address, Type:=8)

Set ws = Worksheets.Add

WorkRng.Copy

For Each Rng In WorkRng

If Rng.Value < 30 Then
        Rng.Value = "< 30"

    End If
Next

With ws.Range("A1")
        .PasteSpecial xlPasteValues
        .PasteSpecial xlPasteFormats
        .PasteSpecial xlPasteValuesAndNumberFormats
End With

ws.Columns("A").AutoFit

Application.CopyCutMode = False

End Sub

当前它会复制所选范围，并使用抑制后的值更新原始数据源和新工作表。如何防止其修改原始数据而仅转换复制的数据？

Answer 1

尝试一下：

Sub SuppressLessThan()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim Rng As Range
    Dim WorkRng As Range
    Dim dTargetNum As Double
    Dim sDefault As String

    dTargetNum = 30

    If TypeName(Selection) = "Range" Then sDefault = Selection.Address
    On Error Resume Next
    Set WorkRng = Application.InputBox("Select the cells you are working with:", "Select Range", sDefault, Type:=8)
    On Error GoTo 0
    If WorkRng Is Nothing Then Exit Sub 'Pressed cancel

    Set wb = WorkRng.Worksheet.Parent
    Set ws = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count))

    WorkRng.Copy
    ws.Range("A1").PasteSpecial xlPasteValues
    ws.Range("A1").PasteSpecial xlPasteFormats
    ws.Range("A1").PasteSpecial xlPasteValuesAndNumberFormats
    Application.CutCopyMode = False

    For Each Rng In ws.UsedRange.Cells
        If Rng.Value < dTargetNum Then Rng.Value = "< " & dTargetNum
    Next Rng

    ws.UsedRange.EntireColumn.AutoFit

End Sub

抑制“ X”下的值并复制到新表

1 个答案: