VBA - 查找副本并比较其中哪一个最高
Posted
tags:
篇首语：本文由小常识网(cha138.com)小编为大家整理，主要介绍了VBA - 查找副本并比较其中哪一个最高相关的知识，希望对你有一定的参考价值。
嘿我正在尝试过滤/匹配我的表单重复，我有两个标准：
- 在
(column B)中的任何地方查找重复项，如果在(column E)中与找到的重复项相同的行中设置了“适用”的重复项。 - 在
(column B)中具有最高数量的(column C)中的一个副本（数字在0-10之间）应该仍然在(column E)中具有“适用”但是最低数字应该在(column E)中被“删除”。我希望我看起来像这样：
Sub FindDUB()
Dim lastRow As Long 'Declaring the lastRow variable
Dim MatchReqprodID As Long 'store the match index values of the given value
Dim MatchRevision As Double 'store the match index values of the given value
Dim RevisionColumnCompare As Integer 'Column number in sheet
Dim ReqprodIDColumnCompare As Integer 'Column number in sheet
Dim CompareReqprodID As Long 'Compare is to loop through all the records in the column using For loop
Dim CompareRevision As Long 'Compare is to loop through all the records in the column using For loop
RevisionColumnCompare = 3 'C
ReqprodIDColumnCompare = 2 'B
'Finding the last row in Reqprod ID
lastRow = Range("B" & Rows.Count).End(xlUp).Row
'looping through the Reqprod ID column
For CompareReqprodID = 1 To lastRow
If Cells(CompareReqprodID, ReqprodIDColumnCompare) <> "" Then 'skipping if it is blank.
'getting match index number for the value of the cell
MatchReqprodID = WorksheetFunction.Match(Cells(CompareReqprodID, ReqprodIDColumnCompare), Range("B1:B" & lastRow), 0)
'MatchRevision = Application.WorksheetFunction.Large(RevisionColumnCompare, 1)
'if the match index is not equals to current row number, then it is a duplicate value
If CompareReqprodID <> MatchReqprodID Then
'If CompareRevision <> MatchRevision Then
' Cells(CompareReqprodID, ApplicableColumn) = "Removed"
' Cells(MatchReqprodID, ApplicableColumn) = "Applicable"
'Else
Cells(CompareReqprodID, ApplicableColumn) = "Applicable"
Cells(MatchReqprodID, ApplicableColumn) = "Removed"
'End If
End If
End If
Next
End Sub
这段代码不稳定，现在不起作用，如果删除了MatchRevision和If CompareRevision <> MatchRevision Then函数，它就可以使用了。然后我可以找到重复项，但不能指出其中哪一个具有最高版本。
所以我的问题是，如果我可以如何过滤我的工作表，找到重复项，并查看具有最高“修订”值的两个重复项，并将最高设置为“适用”，最低设置为“已删除” “在”状态“。谢谢！
答案
Sub FindDUB()
Dim lastRow As Long
Dim currentRow As Long
Dim innerRow As Long
Dim frequency As Integer
Dim currentID As Long
Dim currentValue As Long
Dim firstValue As Long
lastRow = ThisWorkbook.Worksheets("Tabelle1").Range("B" & Rows.Count).End(xlUp).Row
For currentRow = 1 To lastRow
frequency = Application.WorksheetFunction.CountIf(Range("B:B"), Range("B" & currentRow).Value)
If frequency > 1 Then
Range("E" & currentRow).Value = "Removed"
Else
End If
Next currentRow
For currentRow = 1 To lastRow
If Range("E" & currentRow).Value = "Removed" Or Range("E" & currentRow).Value = "Applicable" Then
currentID = CLng(Range("B" & currentRow).Value)
firstValue = CLng(Range("C" & currentRow).Value)
For innerRow = currentRow To lastRow
If CLng(Range("B" & innerRow).Value) = currentID Then
If CLng(Range("C" & innerRow).Value) < firstValue Then
Range("E" & currentRow).Value = "Applicable"
Range("E" & innerRow).Value = "Removed"
ElseIf CLng(Range("C" & innerRow).Value) > firstValue Then
Range("E" & currentRow).Value = "Removed"
Range("E" & innerRow).Value = "Applicable"
Else
End If
Else
End If
Next innerRow
Else
End If
Next currentRow
End Sub
另一答案
如果你想使用公式做到这一点，那么你可以做以下，但请注意，这是非常手动的。
首先，我创建了一些示例数据如下：
A B C D
ReqProdId Revision Owner
12 2 sis
34 4 sis
38 1 hbv
12 3 sis
12 4 sis
34 9 sis
37 4 hbv
因此，列A中没有任何内容，B列是您的产品ID，C列是您的修订号，D列是所有者。您的实际数据从第2行开始。
然后我添加了E = Status，F = Max和G = Min的列标题。
您在单元格F2中键入的列F的公式是=MAX(IF(B:B=B2,C:C))，但您必须按Ctrl-Shift-Enter才能添加此公式。
您在单元格G2中键入的列G的公式是=MIN(IF(B:B=B2,C:C))，但需要使用Ctrl-Shift-Enter输入，以使其正常工作。
将列F和G的公式向下拖动到数据末尾，它们应填充每组的最低/最高版本号。
从这里我们可以最后添加公式来填充Status列，它作为=IF(F2=G2, "", IF(C2=G2,"Removed",IF(C2=F2,"Applicable","")))进入单元格E2。通过简单的Enter，可以正常输入此公式。然后还需要复制到数据表的末尾。
所以逻辑（如果还不清楚）如下：
- 确定每个组的最小修订号;
- 确定每个组的最大修订号;
- 如果最小和最大数字相同则没有重复，因此将状态设置为空白;
- 如果当前修订号与最小号匹配，那么这是该组中的最低值，因此将状态设置为“已删除”;
- 如果当前修订号与最大数匹配，那么这是该组中的最高值，因此将状态设置为“适用”;
- 在所有其他情况下，它位于组的最大和最小数字之间，因此将状态设置为空白。
我做了这个测试，它工作正常，但手动复制公式并不理想。
忘了添加我的结果：
A B C D E F G
ReqProdId Revision Owner Status Max Min
12 2 sis Removed 4 2
34 4 sis Removed 9 4
38 1 hbv 1 1
12 3 sis 4 2
12 4 sis Applicable 4 2
34 9 sis Applicable 9 4
37 4 hbv 4 4
另一答案
尝试使用Dictionary lib。
您需要添加对“Microsoft Scripting Runtime”的引用（工具 - >引用）
sub FindDUB()
dim row, lastRow, firstRow, Id as Long
dim checkedId as Dictionary
Dim ApplicableColumn As Integer 'Column number in sheet
Dim RevisionColumnCompare As Integer 'Column number in sheet
Dim ReqprodIDColumnCompare As Integer 'Column number in sheet
ApplicableColumn = 5 'E
RevisionColumnCompare = 3 'C
ReqprodIDColumnCompare = 2 'B
set checkedId = new Dictionary
firstRow = 'SET HERE THE FIRST ROW OF DATA RANGE IN YOUR COLUMN
lastRow = Range("B" & Rows.Count).End(xlUp).Row
for row = firstRow to lastRow
id = Cells(row,ReqprodIDColumnCompare).value
if checkedId.exists(id) then
'Don't know if you want to compare also EQUALS cells, change as you want it.
if Cells(checkedId(id),RevisionColumnCompare).value < Cells(row,RevisionColumnCompare).value
Cells(checkedId(id),ApplicableColumn).value = "Removed"
checkedId(id).value = row
else
checkedId.add id, row
end if
next
dim key
for each key in checkedId.keys
Cells(checkedId(key),ApplicableColumn).value = "Applicable"
next
end sub
另一答案
我认为这个数组公式会这样做（使用Ctrl，Shift和Enter，大括号将出现在Richard的答案中）。
=IF(COUNTIF($B$2:$B$7,B2)>1,IF(C2=MAX(IF($B$2:$B$7=B2,$C$2:$C$7)),"Applicable","Removed"),"")
以上是关于VBA - 查找副本并比较其中哪一个最高的主要内容，如果未能解决你的问题，请参考以下文章