sirkülasyon
Altın Üye
- Katılım
- 10 Temmuz 2012
- Mesajlar
- 2,532
- Excel Vers. ve Dili
- 2021 LTSC TR
- Altın Üyelik Bitiş Tarihi
- 18-06-2026
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim sayfa As Worksheet
Dim Başlangıcsatırı As Long
Dim sonSatır As Long
Dim i As Long
Set sayfa = ThisWorkbook.Sheets("Lüzum_Müzekkeresi")
Başlangıcsatırı = 10
If Not Intersect(Target, sayfa.Range("C:E")) Is Nothing Then
sonSatır = sayfa.Cells(sayfa.Rows.Count, "C").End(xlUp).row
For i = Başlangıcsatırı To sonSatır
If sayfa.Cells(i, "C").value = sayfa.Cells(i, "C").value And _
sayfa.Cells(i, "D").value = sayfa.Cells(i, "D").value And _
sayfa.Cells(i, "E").value = sayfa.Cells(i, "E").value Then
MsgBox "Mükerrer veri girişi mevcut", vbExclamation
sayfa.Range("B:E").Rows(i).ClearContents
Exit For
End If
Next i
For i = Başlangıcsatırı To sonSatır
If Not IsEmpty(sayfa.Cells(i, "C").value) And _
Not IsEmpty(sayfa.Cells(i, "D").value) And _
Not IsEmpty(sayfa.Cells(i, "E").value) Then
sayfa.Range("B:E").Rows(i).Borders.LineStyle = xlContinuous
End If
Next i
For i = Başlangıcsatırı To sonSatır
If Not IsEmpty(sayfa.Cells(i, "C").value) Then
sayfa.Cells(i, "B").value = i - Başlangıcsatırı + 1
End If
Next i
End If
End Sub
Mükerrer girişi yok ise B:E satırına kenarlık ekleyecek son olarak ta B sütununa sıra numarası verecek.
Ancak sürekli mükerrer uyarısı alıyorum.
Rica etsem yardımcı olabilir misiniz?