Excel VBA - 比较同一列

时间:2017-09-22 22:55:19

标签: excel vba excel-vba excel-2010

我是excel VBA的新手,我需要使用VBA完成一项任务。我希望比较同一列中的值。我想开始与最后一行进行比较并向上移动。过滤的标准是当前和最后一个数字之间的%差异是否大于3%,然后将值复制并粘贴到另一行。复制并粘贴值后,在检查3%差异时,应将数据中的值与先前复制和粘贴的值进行比较。以下示例。提前谢谢。

例如,如果我的数据范围显示在下面

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

1 个答案:

答案 0 :(得分:1)

@Jonathon当我查看您的代码并发现您需要在列中选择值&#34; D&#34;就像那样,

如果选择了值,则没有任何值选择接近任何选定值的3%

和选择标准从下到上依次采用(3000和3005问题)

并将所有选定的值粘贴到&#34; P&#34;

列中

如果它是正确的,那么按照下面的代码,它按照问题

满足你的给定条件

&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39 ;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;& #39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39 ;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;& #39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39 ;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39;&#39; &#39;代码从这里开始

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

&#39; sub end here &#39;&#39;&#39;&#39;&#39;