Soru Benzer veri girişi yapılmış ise ilk veriye ait aynı satırdaki farklı sütundaki hücre içindeki veriyi getir

Katılım
8 Eylül 2008
Mesajlar
950
Excel Vers. ve Dili
2016 İngilizce
Merhaba

Elimde bulunan aşağıdaki makro kod düzeneğinde ufak bir ekleme yapmak istiyorum. fakat bilgim gereği biraz kurcalasam da beceremedim siz üstadlarım yardımını rica ederim. Bu kod düzeneğinde H sütununda belirli bir hücreye veri girdiğim zaman eğer aynı sütunda aynı veriden varsa msgbox olarak çıkan uyarı mesajında benzer verilerin olduğu hücre adreslerini yazıyor.

Ben burada şunu istiyorum. veri girişi yaptığım hücrede değilde aslında önceden varolan hücredeki verinin bulunduğu satırdaki C sütunu içerisinde yazan veri bilgisini de msgbox içerisinde yazsın istiyorum

Bilgi ve yardımlarınızı rica ederim

Örnek dosya link İndir
https://dosya.co/1yino0q5szn9/ornek.rar.html

Kod:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
On Local Error GoTo cikis

Dim adres As String
If Target.Row = 1 Then Exit Sub

    On Error GoTo ErrHandler
    Application.ScreenUpdating = False

    Dim myDataRng As Range
    Dim cell As Range
    

    Set myDataRng = Range("H2:H" & Cells(Rows.Count, "H").End(xlUp).Row)

    For Each cell In myDataRng
        cell.Offset(0, 0).Font.Color = vbBlack


        If Application.Evaluate("COUNTIF(" & myDataRng.Address & "," & cell.Address & ")") > 1 Then
            cell.Offset(0, 0).Font.Color = vbRed
            adres = adres & vbLf & cell.Address & " Numaralı hücre"
        End If
    Next cell

    Set myDataRng = Nothing
ErrHandler:
    Application.EnableEvents = True
    Application.ScreenUpdating = True
    
If Intersect(Target, Range("H:H")) Is Nothing Then Exit Sub

If WorksheetFunction.CountIf(Range("H:H"), Target) > 1 Then
If adres <> "" Then MsgBox "Aşağıda belirtilen hücrelerde benzer veri girişleri yapılmıştır. Düzeltiniz.!" & adres, vbCritical, "Benzer Veri Girişi Uyarısı"
Target = ""
End If
End Sub
 
Üst