VBAマクロはExcelの前の変数に基づいて2つの値の差を計算する - excel、vba、excel-vba

私は既存のVBAコードに追加しようとしていますExcelプロジェクト。 列内の重複値を見つけるためにVBAを探していましたが、結果は別の列に出力されます。たとえば、User1が列に2回入力され、2回目に入力された場合、次の列には「重複」があります。

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

これを変更することは可能ですか？重複が見つかった場合、2つの値の違いについて別の列をチェックします。

だから私が持っていた場合：

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

2つの値の差が= <6の場合、マクロに「エラー」と言ってほしい

回答：

最新のセルと一致の差が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

より一般的なアプローチについては、次のようにします。

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