gpt4 book ai didi

vba - Excel VBA - 比较同一列中的行

转载 作者:行者123 更新时间:2023-12-02 21:24:11 28 4
gpt4 key购买 nike

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

最佳答案

@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

'子在此结束'''''

关于vba - Excel VBA - 比较同一列中的行,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/46374230/

28 4 0
Copyright 2021 - 2024 cfsdn All Rights Reserved 蜀ICP备2022000587号
广告合作:1813099741@qq.com 6ren.com