Private Sub Worksheet_Change(ByVal Target As Range)
Dim dv As Validation
Dim valList As Variant
Dim listItems As String
Dim i As Integer
Dim refFormula As String
Dim refRange As Range
Dim cell As Range
Dim isValid As Boolean
' Eğer birden fazla hücre değişmişse çık
If Target.Cells.Count > 1 Then Exit Sub
' Hedef hücrede veri doğrulama var mı?
On Error Resume Next
Set dv = Target.Validation
On Error GoTo 0
' Eğer doğrulama yoksa çık
If dv Is Nothing Then Exit Sub
' Doğrulamanın gerçekten bir LİSTE olup olmadığını kontrol et
On Error Resume Next
If dv.Type <> xlValidateList Then Exit Sub
On Error GoTo 0
' Veri doğrulama formülünü al
valList = dv.Formula1
' Eğer liste doğrudan bir metinse (örneğin: "Elma,Armut,Çilek")
If Left(valList, 1) <> "=" Then
' Listeyi diziye dönüştür
valList = Split(valList, ",")
' Diziyi kontrol et
isValid = False
For i = LBound(valList) To UBound(valList)
If Trim(Target.Value) = Trim(valList(i)) Then
isValid = True
Exit For
End If
Next i
' Eğer geçerli bir değer bulunmadıysa
If Not isValid Then
Application.EnableEvents = False
MsgBox "Lütfen listeden geçerli bir değer seçin!", vbExclamation, "Geçersiz Giriş"
Target.ClearContents ' Hücreyi temizle
Application.EnableEvents = True
End If
Exit Sub
End If
' Eğer liste başka bir sayfadan referanslıysa
refFormula = Mid(valList, 2) ' "=" işaretini kaldır
' Referanslı hücreleri almak için Evaluate kullanıyoruz
On Error Resume Next
Set refRange = Application.Evaluate(refFormula)
On Error GoTo 0
' Eğer geçerli bir aralık değilse çık
If refRange Is Nothing Then Exit Sub
' Listede değeri bulup kontrol et
For Each cell In refRange
If cell.Value = Target.Value Then Exit Sub
Next cell
' Eğer değer listede yoksa uyarı ver ve hücreyi temizle
Application.EnableEvents = False
MsgBox "Lütfen listeden geçerli bir değer seçin!", vbExclamation, "Geçersiz Giriş"
Target.ClearContents ' Hücreyi temizle
Application.EnableEvents = True
End Sub