Question

我需要撤消复制到worksheet2的帮助。我的代码可以工作，但是我不希望工作表“ Sheet2”和“ Output2”都具有新的数据输出。我只希望“ Output2”具有新的数据输出。如何编写撤消功能或将“ sheet2”数据复制到剪贴板？

撤消和剪贴板是我能想到的唯一选择，但是我在实现方面还没有成功。

感谢您的帮助！

我在“ sheet2”中的数据是温度，从-21度到-132.8度不等。

Sub ForEachTemp1()

For Each a In Worksheets("Sheet2").Range("A2:O21")

If a.Value <= 97 Then
    a.Value = True
ElseIf a.Value >= 97 Then
    a.Value = False

End If
Next a

Worksheets("Sheet2").Range("A2:O21").Copy Worksheets("Output2").Range("A2:O21")


For Each a In Worksheets("Sheet2").Range("A22:O42")

If a.Value >= 97 Then
    a.Value = False
ElseIf a.Value <= 97 Then
    a.Value = True

End If
Next a

Worksheets("Sheet2").Range("A22:O42").Copy Worksheets("Output2").Range("A22:O42")


For Each a In Worksheets("Sheet2").Range("A43:O63")

If a.Value <= -127 Then
    a.Value = False
ElseIf a.Value >= -127 Then
    a.Value = True

End If
Next a

Worksheets("Sheet2").Range("A43:O63").Copy Worksheets("Output2").Range("A43:O63")


End Sub

我希望工作表“ Output2”上的当前输出（新数据输出）相同，但是我不希望新数据输出也填充在“ sheet2”上。

Answer 1

您可以使用工作表公式和Evaluate创建True / False值数组：

Sub ForEachTemp1()

    Dim ws As Worksheet, wsOut As Worksheet

    Set ws = Worksheets("Sheet2")
    Set wsOut = Worksheets("Output2")

    PutArray wsOut.Range("A2"), ws.Evaluate("A2:O21<=97")
    PutArray wsOut.Range("A22"), ws.Evaluate("A22:O42<=97")
    PutArray wsOut.Range("A43"), ws.Evaluate("A43:O63>=-127")

End Sub

'utility sub to place an array onto a worksheet
Sub PutArray(rng As Range, arr)
    rng.Cells(1).Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr
End Sub

Excel非常聪明，可以知道公式何时是数组公式，并创建结果值的二维数组，您可以将其直接分配给输出工作表。

VBA如何撤消？

1 个答案: