修復我的宏以複製/粘貼單元格值如果小於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

來源

2014-09-27 Kim Blm

所以我想我得太多了這一問題。我發現使用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

來源

2014-09-28 16:38:48

修復我的宏以複製/粘貼單元格值如果小於X，否則複製/粘貼Y

回答

相關問題