2014-09-27 120 views
0

美好的一天! :)修复我的宏以复制/粘贴单元格值如果小于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 

回答

0

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