如何检查单元格的迹象，然后将其复制并粘贴到另一张纸上

Question

我有一个数字列，并希望通过每个单元格检查数字是正值还是负数。在确定一个数字是正的之后，或者是负面的，我想将该数字复制并粘贴到新的表上的新表中，将正值和负值分开。

我最初使用了一个嵌套的if语句来执行此操作，但没有得到20个正数的列表，而我的总数为40个数字，我得到了20个正数的列表，我在我的新正面中有20个带有20个错误条件唯一的表（负面的东西）。

我想在不复制它们的情况下拉出正值和负值，或在我的新表中获取IF语句的错误条件。

我一直试图实现的最后一件事是通过我的数字列而不是固定范围进行此代码搜索，因此将来我可以添加数字，而新的正/负面表将自动生成其他数字。<<<<<<<<<<

我是VBA的新手，一般是编码，因此对任何帮助都非常感谢。

谢谢，

olek！

---

我的代码几乎遵循宏代码：

Sub Variance()
'
' Variance Macro
'
'
Range("F2:F60").Select
Selection.Copy
Sheets("Macro").Select
Range("A2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Range("A1:A60").Select
Application.CutCopyMode = False
Selection.NumberFormat = "0.00%"
Selection.AutoFilter
Range("A1").Select
ActiveSheet.Range("$A$1:$A$60").AutoFilter Field:=1, Criteria1:=">=0", _
    Operator:=xlAnd
ActiveWindow.SmallScroll Down:=-12
Range("A3:A60").Select
Selection.Copy
Sheets("Bullseye").Select
Range("AH3").Select
ActiveSheet.Paste
Columns("AH:AH").EntireColumn.AutoFit
ActiveWindow.SmallScroll Down:=-18
Sheets("Macro").Select
Range("A1").Select
ActiveSheet.Range("$A$1:$A$60").AutoFilter Field:=1, Criteria1:="<0", _
    Operator:=xlAnd
ActiveWindow.SmallScroll Down:=-21
Range("A2:A59").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Bullseye").Select
Range("AK3").Select
ActiveSheet.Paste
End Sub

此代码可以完成工作，但我想更改它，以便我可以运行代码，以自动生成我的所有数据，但没有固定范围。此外，如果我想再次运行，我必须删除此宏填充的所有数据。

基本上只是试图减少步骤的数量，以便尽可能完全自动化。

谢谢！

Answer 1

您可以尝试使用变量。在这种情况下，变量Rownum在F列中找到了最后一个值的行号。然后，您可以将变量rownum替换为代码中每个位置中的数字60，从而使您的范围这样的动态范围：

    Dim RowNum As Integer
    RowNum = Sheets("Macro").Cells(Rows.Count, "F").End(xlUp).Row
    Range("F2:F" & RowNum).Select    
    '...
    Range("A2:A" & RowNum).Select

Answer 2

您必须避免所有Select/Selection/Activate/ActiveXXX模式设计，该设计为99,99％，不必要，然后切换到完全合格的范围参考

此外，您不需要任何"中间"表作为"宏"，因为您可以直接过滤数据

Option Explicit
Sub Variance()
    With Worksheets("numbersSheet") '<--| reference your data worksheet (change "numbersSheet" to your actual sheet with numbers name)
        With Range("F1", .Cells(.Rows.count, "F").End(xlUp)) '<--| reference its column "F" range from row 1 (header) down to last not empty row
            FilterAndWrite .Cells, ">=0", Worksheets("Bullseye").Range("AH3") '<--| filter positive or zero values and write them from Worksheets("Bullseye").Range("AH3") downwards
            FilterAndWrite .Cells, "<0", Worksheets("Bullseye").Range("AK3") '<--| filter negative values and write them from Worksheets("Bullseye").Range("AK3") downwards
        End With
        .AutoFilterMode = False
    End With
End Sub
Sub FilterAndWrite(sourceRng As Range, criterium As String, targetRng As Range)
    With sourceRng
        .AutoFilter Field:=1, Criteria1:=criterium
        If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then '<--| if any filtered cells other than header
            .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).Copy '<--| copy filtered cell skipping header
            targetRng.PasteSpecial xlPasteValues '<--| paste values in passed target range
        End If
    End With
End Sub