VBAmacrosexcel，根据以前的variables计算两个值之间的差异

我正在尝试添加到Excel项目的现有VBA代码。 我正在寻找一个VBA来查找列中的重复值，结果将打印在另一列。 例如，如果User1在列中input两次，则第二次input – 下一列中将出现“重复”。

Sub DuplicateFinder() Dim LastRow As Long Dim matchFoundIndex As Long Dim iCntr As Long LastRow = Range("A65000").End(xlUp).Row For iCntr = 1 To LastRow If Cells(iCntr, 1) <> "" Then matchFoundIndex = WorksheetFunction.Match(Cells(iCntr, 1), Range("A1:A" & LastRow), 0) If iCntr <> matchFoundIndex Then Cells(iCntr, 2) = "Duplicate" End If End If Next End Sub 

是否有可能修改这个，然后当find一个副本时，它将检查另一列中的两个值之间的差异。

所以如果我有一个：

  A | B | C | D user1 11 user2 11 user1 duplicate 12 "error" 

如果两个值之间的差异是<= 6，我希望macros说“错误”

Answer 1

如果你想检查最近的单元格和匹配的区别是不是<= 6：

 If iCntr <> matchFoundIndex Then Cells(iCntr, 2) = "Duplicate" If Cells(iCntr, 3) - Cells(matchFoundIndex, 3) <= 6 Then Cells(iCntr, 4) = "Error" End If End If 

如果你想要绝对的区别：

 If Abs(Cells(iCntr, 3) - Cells(matchFoundIndex, 3)) <= 6 Then 

Answer 2

对于更一般的方法，我会像下面这样：

 Option Explicit Sub DuplicateFinder() Dim user As Variant With Sheets("duplicates") '<--| change "duplicates" to your actual sheet name With .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)) '<--| reference its column A range from row 1 (header) down to the one corresponding to last column A not empty row For Each user In GetUsers(.Resize(.Rows.Count - 1).Offset(1)) '<-- get unique users starting from 2nd row downwards and loop through them If Application.WorksheetFunction.CountIf(.Cells, user) > 1 Then HandleUser .Cells, user '<--| if more then one current user occurrences then "handle" it Next End With .AutoFilterMode = False End With End Sub Sub HandleUser(rng As Range, user As Variant) Dim cell As Range Dim iCell As Long, refvalue As Long With rng .AutoFilter Field:=1, Criteria1:=user '<--| filter column A cells with current 'user' With .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible) '<-- reference filtered cells, skippinh headers refvalue = .Cells(, 2).Value '<--| retrieve first occurrence value from cell two columns to the right For Each cell In .Cells '<--| loop through filtered cells If iCell > 0 Then '<--| start handling occurrences form the 2nd one on cell.Offset(, 1) = "Duplicate" '<--| mark it as duplicate If cell.Offset(, 2) - refvalue > 6 Then cell.Offset(, 3) = "error" '<--| place "error" if two cells to the right from current 'user' has a value greater then first occurrence value + 6 End If iCell = iCell + 1 '<--| update user occurrences counter Next End With End With End Sub Function GetUsers(rng As Range) As Variant Dim cell As Range With CreateObject("Scripting.Dictionary") For Each cell In rng .Item(cell.Value) = cell.Value Next cell GetUsers = .keys End With End Function