Excel VBA-比较同一列中的行

我是excel VBA新手，我有一项任务需要使用VBA完成。我希望比较同一列中的值。我想开始与最后一行进行比较并向上移动。筛选条件是，如果当前和最后一个数字之间的百分比差异大于3%，则将该值复制并粘贴到另一行。复制和粘贴值后，在检查3%的差异时，应将数据中的值与先前复制和粘贴的值进行比较。下面的例子。提前谢谢

Sub main2()

Dim row_a As Long
Dim row_b As Long
Dim l_2

row_b = Range("D5000").End(xlUp).Row
Cells(row_b, "d").Copy Cells(row_b, "P")

l_2 = row_b - 1

For i = row_b To 3 Step -1
    a = Cells(row_b, "d").Value
    For j = l_2 To 3 Step -1
        If a / Cells(j, "d") <= 0.97 Or a / Cells(j, "d") >= 1.03 Then
            Cells(j, "d").Copy Cells(j, "p")
            a = Cells(j, "d").Value
        End If
    Next j
Next i

End Sub

例如，如果我的数据范围如下所示

1100
1285
1290
3005
1500
2020
2030
2040
2050
2060
2070
2080
2100
2500
3000

这应该是我的结果：

1100
1290 
1500 
2030 
2100 
2500 
3000

我现在得到的结果是3005（3000和3005之间的差异小于3%（3005/3000），因此3005不应该在列表中），而它不应该在列表中

1100
1290
3005
1500
2030
2100
2500
3000

这是我目前掌握的密码。提前谢谢

Sub main2()

Dim row_a As Long
Dim row_b As Long
Dim l_2

row_b = Range("D5000").End(xlUp).Row
Cells(row_b, "d").Copy Cells(row_b, "P")

l_2 = row_b - 1

For i = row_b To 3 Step -1
    a = Cells(row_b, "d").Value
    For j = l_2 To 3 Step -1
        If a / Cells(j, "d") <= 0.97 Or a / Cells(j, "d") >= 1.03 Then
            Cells(j, "d").Copy Cells(j, "p")
            a = Cells(j, "d").Value
        End If
    Next j
Next i

End Sub

Sub main2（）
暗淡的一排像长的一样
昏暗的b排，如长
暗l_2
行_b=范围（“D5000”）。结束（xlUp）。行
单元格（b行，“d”）。复制单元格（b行，“P”）
l_2=第b行-1
对于i=第b行至第3步-1
a=单元格（第b行，“d”）。数值
对于j=l_2至3步骤-1
如果a/单元格（j，“d”）=1.03，则
细胞（j，“d”）。复制细胞（j，“p”）
a=单元格（j，“d”）。数值
如果结束
下一个j
接下来我
端接头

@Jonathon当我查看您的代码时，发现您需要像这样选择“D”列中的值

如果选择了值，则在任何选定值的3%附近不选择任何值

选择标准从下到上，先到先，按照你在（3000一个3005问题）中的建议

并将所有选定值粘贴到“p”列中

如果它是正确的，那么按照问题，通过下面的代码，它满足您给定的条件

撸撸撸撸撸 '代码从这里开始

Sub Filter3Per()

Dim LastRow As Integer
Dim ComVal As String


'''''''''Apply filter on columun with loop as per criteria
'Read last Row from D column
LastRow = Cells(Rows.Count, "D").End(xlUp).Row

'Clear format color of column D
Range("D:D").Interior.ColorIndex = -4142

'''Clear P column
Range("P:P").ClearContents
'Loop Goes from botttom to top 3 row
For i = LastRow - 1 To 1 Step -1
    'Read compvalue
    ComVal = Cells(i + 1, "D").Value

    'Check for color
    If Cells(i + 1, "D").Interior.ColorIndex <> 3 Then

        'Loop to Check as Criteria
        For j = i To 1 Step -1

        'Critera
        If ComVal / Cells(j, "D") <= 0.97 Or ComVal / Cells(j, "D") >= 1.03 Then

        Else
        Cells(j, "D").Interior.ColorIndex = 3

        End If
        Next

    End If

Next

''''''''Apply filter on columun with loop as per criteria End here
'''''''''''''''Collect value''''''''''''''''''''
'''Clear P column

Range("P:P").ClearContents
For i = 1 To LastRow

    If Cells(i, "D").Interior.ColorIndex <> 3 Then

     Cells(i, "P").Value = Cells(i, "D") 'add value in p Column

    End If
Next
'''''''''''Collect value end here
End Sub

Sub-Filter3Per（）
将最后一行设置为整数
朦胧的康瓦尔
根据标准在带回路的columun上应用过滤器
'读取D列的最后一行
LastRow=单元格（Rows.Count，“D”）.End（xlUp）.Row
'清除D列的格式颜色
范围（“D:D”）.Interior.ColorIndex=-4142
''清除P列
范围（“P:P”）。ClearContents
'循环从底部到顶部3行
对于i=最后一行-1到1步骤-1
'读取compvalue
ComVal=单元格（i+1，“D”）。值
“检查颜色
如果单元格（i+1，“D”）.Interior.ColorIndex 3则
'循环以检查为条件
对于j=i到1步骤-1
“克里特拉
如果ComVal/Cells（j，“D”）=1.03，则
其他的
单元格（j，“D”）。内部颜色指数=3
如果结束
下一个
如果结束
下一个
根据标准在columun上应用过滤器，并在此处结束循环
集资
''清除P列
范围（“P:P”）。ClearContents
对于i=1到最后一行
如果单元格（i，“D”）.Interior.ColorIndex 3则
单元格（i，“P”）。值=单元格（i，“D”）在P列中添加值
如果结束
下一个
收集价值到此为止
端接头

“在这里结束

---

根据您自己的规范，3005应该在列表中，因为3005和1290之间的差异以及3005和1500之间的差异都大于3%。。。请重新考虑你的建议specification@Jonathon-Sidwell，如果你能至少描述一下你在使用你的查询做什么，这将对这篇文章的任何读者都有帮助。由于指定所需的方法似乎有一些困难。请始终使用完全限定的范围引用，例如，

Dim ws as WorkSheet

，后跟

Set ws=thiswoolk.WorkSheets（“MySheetName”）

。例如，您可以精确地引用

ws.Cells（i+1，“D”）

，而不是单独引用

Cells

。最好通过内部颜色索引标记排除值，而不是使用额外的列。您的ComVal声明为字符串将导致类型错误。@TM是的，它与字符串一样长