Bulunan verilerin tek mesajla gösterimi

[şahins1]

İyi Günler Diliyorum,
Ekteki dosyada A kolonuna girilecek veriler olacak. Her veriyi girdiğimizde üstteki verileri kontrol edecek, aynılarını ve içinde geçtiği verileri bulacak ve mesajla bildirecek. Benim amatörce hazırladığım kodlar bunu yapıyor sadece her veriyi ayrı mesajda veriyor. Bütün bulunan verileri tek mesajla gösterme yolu var mı? Şimdiden teşekkür ederim.

 

[halit3]

İyi Günler Diliyorum,
Ekteki dosyada A kolonuna girilecek veriler olacak. Her veriyi girdiğimizde üstteki verileri kontrol edecek, aynılarını ve içinde geçtiği verileri bulacak ve mesajla bildirecek. Benim amatörce hazırladığım kodlar bunu yapıyor sadece her veriyi ayrı mesajda veriyor. Bütün bulunan verileri tek mesajla gösterme yolu var mı? Şimdiden teşekkür ederim.

bu kodu oenermisiniz

Private Sub Worksheet_Change(ByVal Target As Range)
Dim svs, t, i As Integer
Dim s, k, bul
t = 0
svs = [a65536].End(3).Row
'If Target.Address <> Range("A" & svs) Then Exit Sub
For i = svs To 2 Step -1
    If Trim(UCase(Cells(i - 1, 1))) = Trim(UCase(Range("A" & svs))) Then 'Bu If döngüsü son girdiğimiz verinin aynısına rastladığı verinin hücre adresini bulmak için
        t = t + 1                                                           'yani j3-a1=j3-a1   gibi
        s = "Bu pafta ile bire bir eşleşen paftaların adresleri" & vbCrLf
        s = s & Cells(i - 1, 1).Address(False, False)
        'MsgBox s, vbOKOnly, "EŞLEŞEN PAFTALARIN ADRESLERİ"
       eşleş1 = eşleş1 & Cells(i - 1, 1).Address(False, False) & Chr(13)
    End If
    
Next
For i = svs To 2 Step -1    'ikinci for  un sebebi mesajları ayırmak
    If Trim(UCase(Cells(i - 1, 1))) = Trim(UCase(Range("A" & svs))) Then
    ElseIf Left(Trim(UCase(Cells(i - 1, 1))), Len(Range("A" & svs))) = Trim(UCase(Range("A" & svs))) Then 'Bu If döngüsü son girdiğimiz verinin içinde geçtiği hücrelerin adresini bulmak için
        t = t + 1                                                                                   'yani j3-a1-a2=j3-a1   gibi
        k = "Bu paftanın içinde yer aldığı paftaların adresleri" & vbCrLf
        k = k & Cells(i - 1, 1).Address(False, False)
        'MsgBox k, vbOKOnly, "İÇİNDE YER ALDIĞI PAFTALARIN ADRESLERİ"
        eşleş2 = eşleş2 & Cells(i - 1, 1).Address(False, False) & Chr(13)
    End If
    
Next
For i = svs To 2 Step -1
    If Trim(UCase(Cells(i - 1, 1))) = Trim(UCase(Range("A" & svs))) Then
    ElseIf Left(Trim(UCase(Range("A" & svs))), Len(Cells(i - 1, 1))) = Trim(UCase(Cells(i - 1, 1))) Then 'Bu If döngüsü son girdiğimiz verinin içinde geçen hücrelerin adresini bulmak için
        t = t + 1
        k = "Bu paftanın içinde yer alan paftaların adresleri" & vbCrLf
        k = k & Cells(i - 1, 1).Address(False, False)
        'MsgBox k, vbOKOnly, "İÇİNDE YER ALAN PAFTALARIN ADRESLERİ"
         eşleş3 = eşleş3 & Cells(i - 1, 1).Address(False, False) & Chr(13)
    End If
Next
MsgBox "Bu pafta ile bire bir eşleşen paftaların adresleri" & vbCrLf & eşleş1, vbOKOnly, "EŞLEŞEN PAFTALARIN ADRESLERİ"
MsgBox "Bu paftanın içinde yer aldığı paftaların adresleri" & vbCrLf & eşleş2, vbOKOnly, "İÇİNDE YER ALDIĞI PAFTALARIN ADRESLERİ"
MsgBox "Bu paftanın içinde yer alan paftaların adresleri" & vbCrLf & eşleş3, vbOKOnly, "İÇİNDE YER ALAN PAFTALARIN ADRESLERİ"

End Sub

 

[şahins1]

İlginiz için çok teşekkür ederim. Sonuç İstediğim gibi. İyi çalışmalar diliyorum.