Question

我有一列数字，想要查看每个单元格以检查数字是正数还是负数。在确定数字是正数还是负数后，我想将该数字复制并粘贴到新表上的新表中，将新正负值分隔开来。

我使用了嵌套的if语句来完成这项工作，但是我没有得到20个正数的列表，而是从我的40个数字中得到20个负数，我得到了一个20个正数的列表，其中包含20个错误条件只有表格（与否定相同）。

我想在不重复它们的情况下提取正值和负值，或者在新表中获取if语句的错误条件。

我试图实现的最后一件事是通过我的数字列而不是固定范围来搜索代码，以便将来我可以添加数字，新的正/负表将自动生成额外的数字。< / p>

我对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

如何检查单元格的符号，然后将其复制并粘贴到另一个工作表？

2 个答案: