我有啟用宏的 excel 檔案 - Sheet_Change.xlsm
與前一行中的第 2 列和第 5 列相比，我需要限制用戶在第 2 列和第 5 列中輸入重復值
但是在我的代碼（如下）中，如果第 2 列或第 5 列與前一行中這些列的值相比有重復項，它會限制輸入重復項。雖然我的目標是有一個警告/行動 - 當兩列都有重復的值時
請看截圖示例：
請幫忙！
我在“Sheet1”中使用以下 vba 代碼：
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If (.Column <> 2 And .Column <> 5) Or .Cells.Count > 1 Then Exit Sub
If WorksheetFunction.CountIfs(Columns(.Column), .Value) > 1 Then
Application.DisplayAlerts = False
.ClearContents
Application.DisplayAlerts = True
MsgBox "Duplicate value!"
End If
End With
End Sub
uj5u.com熱心網友回復：
在第 2 列上使用 Find、FindNext，然后檢查第 5 列中的值。注意 - 這將在任何行中找到重復項，而不僅僅是前一行。
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const PK1 = 2 ' Primary Keys
Const PK2 = 5
Dim V1, V2, rng As Range, first As String
If (Target.Column = PK1) Or (Target.Column = PK2) Then
V1 = Me.Cells(Target.Row, PK1) ' B
V2 = Me.Cells(Target.Row, PK2) ' E
If V1 = "" Or V2 = "" Then Exit Sub
Else
Exit Sub
End If
With Me.Columns(PK1)
Set rng = .Find(V1, lookat:=xlWhole, LookIn:=xlValues)
If Not rng Is Nothing Then
first = rng.Address
Do
If (rng.Row <> Target.Row) And (Cells(rng.Row, PK2) = V2) Then
MsgBox "Duplicate Value " & V1 & "," & V2, vbExclamation, "Row " & rng.Row
Target.Select
Application.EnableEvents = False
Target.Clear
Application.EnableEvents = True
Exit Do
End If
Set rng = .FindNext(rng)
Loop While rng.Address <> first
End If
End With
End Sub
轉載請註明出處，本文鏈接：https://www.uj5u.com/shujuku/396383.html