Question

美好的一天！：）

我正在使用以下VBA从A列复制单元格（从第2行开始），其值小于A列中的最大数据集值，并将它们粘贴到C列（相同的行）中，对于这些列与A列中的最大数据集值相同的单元格，使用空列B将它们作为零（相同行）粘贴到列C中。

单元格D2是A列中单元格范围的最大值，为=MAX(A2:A100)

当从同一张纸上的表格按钮运行这个宏（我在网上找到）时，它就像魅力一样工作：

Sub CopyOrReplaceWithZero ()

    Dim LastRow As Long

    LastRow = Cells(Rows.Count, "A").End(xlUp).Row
    Range("C2:C" & LastRow) = Evaluate("IF(A2:A" & LastRow & "=D2,B2:B" & LastRow & ",IF(A2:A" & _
            LastRow & "<D2,A2:A" & LastRow & ",C2:C" & LastRow & "))")

End Sub

但是，我需要指定运行该宏的工作表，因为我想将它分配给另一个工作表上的表单按钮。因此，当单击该按钮时，数据将从该工作表（copySheet）复制到目标工作表（pasteSheet），然后运行上面的VBA（在pasteSheet上）。

到目前为止，这是我所拥有的，这可能是一种错误的方法。

copySheet的第一部分并粘贴到pasteSheet中可以正常工作。但上面的VBA从copySheet复制并粘贴到pasteSheet中，而它应该是从/到pasteSheet复制和粘贴。

我知道我做错了什么，但到目前为止我无法弄清楚：

Sub copyConvert()

  Application.DisplayAlerts = False
  Application.ScreenUpdating = False

  Dim copySheet As Worksheet
  Dim pasteSheet As Worksheet
  Dim LastRow As Long

  Set copySheet = Worksheets("sheet1")
  Set pasteSheet = Worksheets("sheet2")

  copySheet.Range("P1:P115").Copy
  pasteSheet.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
     :=False, Transpose:=False

  Application.CutCopyMode = False
  Application.DisplayAlerts = True

    LastRow = Sheets("sheet2").Cells(Rows.Count, "A").End(xlUp).Row
    pasteSheet.Range("C2:C" & LastRow) = Evaluate("IF(A2:A" & LastRow & "=D2,B2:B" & LastRow & ",IF(A2:A" & _
            LastRow & "<D2,A2:A" & LastRow & ",C2:C" & LastRow & "))")

  Application.ScreenUpdating = True

End Sub

Answer 1

所以我想我是在推翻这个问题。我发现只使用IF函数更简单的解决方案，如此。我希望其他人可能会认为这很有用：

如果A列中的行是A列中数据集的最大值，则此函数只是将零置于列B（在同一行中），否则，如果A列的每行中的值小于A列中的最大数据集值粘贴到B列（同一行）而不进行修改。

=IF(A2=$C$2, A2*0, IF(A2<$C$2, A2))

单元格C2为=MAX(A2:A100)

我还在使用相同的复制/粘贴命令：

Sub CopyPaste

    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    Dim copySheet As Worksheet
    Dim pasteSheet As Worksheet

    Set copySheet = Worksheets("sheet1")
    Set pasteSheet = Worksheets("sheet2")

    copySheet.Range("P1:P115").Copy
    pasteSheet.Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False

    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True

End Sub

修复我的宏以复制/粘贴单元格值（如果小于X），否则复制/粘贴Y.

1 个答案: