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

问题描述：

我使用以下VBA从列A（从第2行开始）复制值小于列A的最大数据集值的单元格，并将它们粘贴到列C（相同行）中，然后将它们粘贴到列C对于与列A中的最大数据集值相同值的那些列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复制并粘贴到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

答

所以我想我得太多了这一问题。我发现使用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

相关推荐