• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Yeni girişin listeden kontrolü ve uyarı alma

Katılım
19 Haziran 2009
Mesajlar
90
Excel Vers. ve Dili
excel2016
Merhaba arkadaşlar,

https://drive.google.com/file/d/0B5zZlbq5mVAVTS1Gc3ktbVpoa3M/view?usp=sharing
Ekte bulunan excel dosyasının "Giriş" sekmesinde "Adı, Soyadı, İl, Yer, Konu" adlı sütunlar bulunuyor.

Bu sütunlara girdiğimiz değerlerin "Tümü" sekmesinde olup olmadığının kontrolünü yapmak istiyorum.

Kontrol yapıldıktan sonra

"Uygun Giriş"

YADA
"Aynı ad ve soyadlı girişler mevcut. Satır No: 5, 20, 22"
"Aynı yer ve konulu girişler mevcut. Satır No: 7, 14"
"Aynı il, yer ve konulu girişler mevcut. Satır No: 7"

şeklinde uyarıları nasıl alabilirim?

Yardımcı olursanız sevinirim.

Çok teşekkürler...
 
Deneyin.

Kod:
Sub AD_SOYAD_KONTROL()
    Dim S1 As Worksheet, S2 As Worksheet, Bul As Range, Adres As String, Satir As String
    
    Set S1 = Sheets("GİRİŞ")
    Set S2 = Sheets("TÜMÜ")
    
    Set Bul = S2.Range("B:B").Find(S1.Range("B4").Value, , , xlWhole)
    If Not Bul Is Nothing Then
        Adres = Bul.Address
        Do
            If Bul.Offset(0, 1).Value = S1.Range("C4").Value Then
                If Satir = "" Then
                    Satir = Bul.Row
                Else
                    Satir = Satir & " , " & Bul.Row
                End If
            End If
            Set Bul = S2.Range("B:B").FindNext(Bul)
        Loop While Not Bul Is Nothing And Bul.Address <> Adres
    End If
    
    If Satir <> "" Then
        MsgBox "Aynı ad ve soyadlı girişler mevcut." & Chr(10) & Chr(10) & _
               "Satır No: " & Satir, vbCritical, "Dikkat !"
    End If
End Sub

Sub İL_YER_KONU_KONTROL()
    Dim S1 As Worksheet, S2 As Worksheet, Bul As Range, Adres As String, Satir As String
    
    Set S1 = Sheets("GİRİŞ")
    Set S2 = Sheets("TÜMÜ")
    
    Set Bul = S2.Range("D:D").Find(S1.Range("D4").Value, , , xlWhole)
    If Not Bul Is Nothing Then
        Adres = Bul.Address
        Do
            If Bul.Offset(0, 1).Value = S1.Range("E4").Value And Bul.Offset(0, 2).Value = S1.Range("F4").Value Then
                If Satir = "" Then
                    Satir = Bul.Row
                Else
                    Satir = Satir & " , " & Bul.Row
                End If
            End If
            Set Bul = S2.Range("D:D").FindNext(Bul)
        Loop While Not Bul Is Nothing And Bul.Address <> Adres
    End If
    
    If Satir <> "" Then
        MsgBox "Aynı il, yer ve konulu girişler mevcut." & Chr(10) & Chr(10) & _
               "Satır No: " & Satir, vbCritical, "Dikkat !"
    End If
End Sub

Sub YER_KONU_KONTROL()
    Dim S1 As Worksheet, S2 As Worksheet, Bul As Range, Adres As String, Satir As String
    
    Set S1 = Sheets("GİRİŞ")
    Set S2 = Sheets("TÜMÜ")
    
    Set Bul = S2.Range("E:E").Find(S1.Range("E4").Value, , , xlWhole)
    If Not Bul Is Nothing Then
        Adres = Bul.Address
        Do
            If Bul.Offset(0, 1).Value = S1.Range("F4").Value Then
                If Satir = "" Then
                    Satir = Bul.Row
                Else
                    Satir = Satir & " , " & Bul.Row
                End If
            End If
            Set Bul = S2.Range("E:E").FindNext(Bul)
        Loop While Not Bul Is Nothing And Bul.Address <> Adres
    End If
    
    If Satir <> "" Then
        MsgBox "Aynı yer ve konulu girişler mevcut." & Chr(10) & Chr(10) & _
               "Satır No: " & Satir, vbCritical, "Dikkat !"
    End If
End Sub
 
çok teşekkür ederim. elinize sağlık
 
Geri
Üst