AccessTr.neT

Rica ederim.
Alttaki kodu deneyin abey.YENİ CARİ sayfasına eklenecek kod.

Dim bul As Range, kacinci As Long



Private Sub Worksheet_Change(ByVal Target As Range)



    Dim satir As Long, sutun As Byte, aranan, hedefsutun As String



    kacinci = 1

    If Not Intersect(Target, Range("B2:B1048576,F2:F1048576,R2:R1048576")) Is Nothing Then

        Select Case Target.Column

            Case 2: satir = Target.Row: sutun = Target.Column: aranan = Target.Value: hedefsutun = "B:B"

            Case 6: satir = Target.Row: sutun = Target.Column: aranan = Target.Value: hedefsutun = "i:i"

            Case 18: satir = Target.Row: sutun = Target.Column: aranan = Target.Value: hedefsutun = "H:H"

        End Select

        varmi sutun, hedefsutun, satir, sutun, aranan

    End If

End Sub



Function varmi(alan As Byte, aranansutun As String, satir As Long, sutun As Byte, aranan)

    If satir > 1 And sutun = alan Then

        If Trim(Cells(satir, sutun).Value) <> "" Then

            If Cells(satir, sutun).Cells.Count = 1 Then

                Set bul = Sayfa2.Range(aranansutun).Find(aranan, , , 1)

                If Not bul Is Nothing Then kacinci = bul.Row

            End If

        End If

    End If

    

    If kacinci > 1 Then

        MsgBox "ilgili veri bulundu", vbCritical, "mükerrer"

        Exit Function

    End If

End Function

cari listesinin bulunduğu sayfanın adaı Sayfa1,Sayfa2.. v.s. her neyse Carilistesi olarak değiştirin. Yada yazdığım kod satırlarındaki "Carilistesi" yazısını cari listenizin bulunduğu sayfa adıyla değiştirin(Sayfa2 gibi)
Yenicari sayfanızdaki alanlarıyla aynı olan Carilistenizdeki alanlarda alan isimleri aynı olsun.
Cari Listesindeki alanbaşlığı CARI_ISIM ise Yeni cari sayfasındaki alanbaşlığıda aynı olsun(CARI_ISIM). Çünkü aramayı alanbaşığına göre yaptım.
Geliştirici sekmesinden Commanbuton ekleyin ve içine aşağıdaki döngüyü yapıştırın.
Yenicari listesine 1 den fazla kayıt alınacaksa sorgulamaya eklenme yapılması gerekiyor. Bu sadece 1 kayıt için geçerli.
For a = 2 To 50
If Cells(2, a) <> "" Then
For b = 2 To 50
If Cells(1, a) = Carilistesi.Cells(1, b) Then
say = 0
For c = 2 To 100000
If Carilistesi.Cells(c, b) <> "" Then
If Cells(2, a) = Carilistesi.Cells(c, b) Then
say = say + 1
End If
End If
Next c
If say = 0 Then
MsgBox "Müşteri Daha Önceden Kayıtlı Değil"
c = 100000
b = 50
a = 50
End If
If say <> 0 Then
MsgBox "Müşteri Daha Önceden Kayıtlı"
c = 100000
b = 50
a = 50
End If
End If
Next b
End If
Next a

Kodları böyle yapın öncekide doğru lakin gereksiz parametre eklemişim

Dim bul As Range, kacinci As Long



Private Sub Worksheet_Change(ByVal Target As Range)



    Dim satir As Long, sutun As Byte, aranan, hedefsutun As String



    kacinci = 1

    If Not Intersect(Target, Range("B2:B1048576,F2:F1048576,R2:R1048576")) Is Nothing Then

        Select Case Target.Column

            Case 2: satir = Target.Row: sutun = Target.Column: aranan = Target.Value: hedefsutun = "B:B"

            Case 6: satir = Target.Row: sutun = Target.Column: aranan = Target.Value: hedefsutun = "i:i"

            Case 18: satir = Target.Row: sutun = Target.Column: aranan = Target.Value: hedefsutun = "H:H"

        End Select

        varmi sutun, hedefsutun, satir, aranan

    End If

End Sub



Function varmi(alan As Byte, aranansutun As String, satir As Long, aranan)

    If satir > 1 Then

        If Trim(Cells(satir, alan).Value) <> "" Then

            If Cells(satir, alan).Cells.Count = 1 Then

                Set bul = Sayfa2.Range(aranansutun).Find(aranan, , , 1)

                If Not bul Is Nothing Then kacinci = bul.Row

            End If

        End If

    End If

    

    If kacinci > 1 Then

        MsgBox "ilgili veri bulundu", vbCritical, "mükerrer"

    End If

    Set bul = Nothing

End Function

(24/10/2020, 22:07)feraz yazdı: [ -> ]Kodları böyle yapın öncekide doğru lakin gereksiz parametre eklemişim

Dim bul As Range, kacinci As Long



Private Sub Worksheet_Change(ByVal Target As Range)



    Dim satir As Long, sutun As Byte, aranan, hedefsutun As String



    kacinci = 1

    If Not Intersect(Target, Range("B2:B1048576,F2:F1048576,R2:R1048576")) Is Nothing Then

        Select Case Target.Column

            Case 2: satir = Target.Row: sutun = Target.Column: aranan = Target.Value: hedefsutun = "B:B"

            Case 6: satir = Target.Row: sutun = Target.Column: aranan = Target.Value: hedefsutun = "i:i"

            Case 18: satir = Target.Row: sutun = Target.Column: aranan = Target.Value: hedefsutun = "H:H"

        End Select

        varmi sutun, hedefsutun, satir, aranan

    End If

End Sub



Function varmi(alan As Byte, aranansutun As String, satir As Long, aranan)

    If satir > 1 Then

        If Trim(Cells(satir, alan).Value) <> "" Then

            If Cells(satir, alan).Cells.Count = 1 Then

                Set bul = Sayfa2.Range(aranansutun).Find(aranan, , , 1)

                If Not bul Is Nothing Then kacinci = bul.Row

            End If

        End If

    End If

    

    If kacinci > 1 Then

        MsgBox "ilgili veri bulundu", vbCritical, "mükerrer"

    End If

    Set bul = Nothing

End Function

@feraz hocam tam olmuş, biraz daha geliştirebilir miyiz, Diyelimki isimden eşleşme oldu. Eşleşen kaydı YENİ CARİ sayfasına getirebilirmiyiz ?

Crtl+F ile bulup kopyala yapıştır da yaparım ancak daha pratik olur mu acaba ?

---

Birde hocam 12-13000 satır kayıt var.. Kasar mı kodlar..

---

(24/10/2020, 22:06)fenerli6774 yazdı: [ -> ]cari listesinin bulunduğu sayfanın adaı Sayfa1,Sayfa2.. v.s. her neyse Carilistesi olarak değiştirin. Yada yazdığım kod satırlarındaki "Carilistesi" yazısını cari listenizin bulunduğu sayfa adıyla değiştirin(Sayfa2 gibi)
Yenicari sayfanızdaki alanlarıyla aynı olan Carilistenizdeki alanlarda alan isimleri aynı olsun.
Cari Listesindeki alanbaşlığı CARI_ISIM ise Yeni cari sayfasındaki alanbaşlığıda aynı olsun(CARI_ISIM). Çünkü aramayı alanbaşığına göre yaptım.
Geliştirici sekmesinden Commanbuton ekleyin ve içine aşağıdaki döngüyü yapıştırın.
Yenicari listesine 1 den fazla kayıt alınacaksa sorgulamaya eklenme yapılması gerekiyor. Bu sadece 1 kayıt için geçerli.
For a = 2 To 50
  If Cells(2, a) <> "" Then
      For b = 2 To 50
        If Cells(1, a) = Carilistesi.Cells(1, b) Then
            say = 0
            For c = 2 To 100000
              If Carilistesi.Cells(c, b) <> "" Then
                If Cells(2, a) = Carilistesi.Cells(c, b) Then
                    say = say + 1
                End If
              End If
            Next c
            If say = 0 Then
              MsgBox "Müşteri Daha Önceden Kayıtlı Değil"
              c = 100000
              b = 50
              a = 50
            End If
            If say <> 0 Then
              MsgBox "Müşteri Daha Önceden Kayıtlı"
              c = 100000
              b = 50
              a = 50
            End If
        End If
      Next b
  End If
Next a

@fenerli6774 hocam emek verip kod uyarlamışsınız. Emeğinize sağlık, teşekkür etmeden geçmek olmaz.

If kacinci > 1 Then
        MsgBox "ilgili veri bulundu", vbCritical, "mükerrer"
    End If

Yukarıdaki kodun if ile end if arasına yazılabilir mesaj silinip.
Zaten kaçıncı>1 demek kaçıncı bulunan satır no demektir.satir ise yazılan verinin bulunduğu satır no.
Mobilden kafadan örnek olarak yazayım yanlışlık olabilir.

Cells(satir,1).value = sayfa2.cells(kacinci,1).value

Bunun gibi olabilir bir deneme yapın abey

---

Kod şöyle çalışır.
Tel,tc no,yada ad soyad sütunlarına veri girince arama yapar.Örneğin Ad soyad girdiniz varsa mesaj verir eklemez.Diğerleride aynı.
Aslında ad soyad varsa birde tc no ve telefonada baktırılabilinirdi esasen.
Malum aynı ad soyadlı insanlar olabilir.
Gerçi zaten tc no ve tel olayına bakıyor kod

(24/10/2020, 22:27)feraz yazdı: [ -> ]If kacinci > 1 Then
        MsgBox "ilgili veri bulundu", vbCritical, "mükerrer"
    End If

Yukarıdaki kodun if ile end if arasına yazılabilir mesaj silinip.
Zaten kaçıncı>1 demek kaçıncı bulunan satır no demektir.satir ise yazılan verinin bulunduğu satır no.
Mobilden kafadan örnek olarak yazayım yanlışlık olabilir.

Cells(satir,1).value = sayfa2.cells(kacinci,1).value

Bunun gibi olabilir bir deneme yapın abey

---

Kod şöyle çalışır.
Tel,tc no,yada ad soyad sütunlarına veri girince arama yapar.Örneğin Ad soyad girdiniz varsa mesaj verir eklemez.Diğerleride aynı.
Aslında ad soyad varsa birde tc no ve telefonada baktırılabilinirdi esasen.
Malum aynı ad soyadlı insanlar olabilir.
Gerçi zaten tc no ve tel olayına bakıyor kod

hocam Cells(satir,1).value = sayfa2.cells(kacinci,1).value yapınca ilgili kaydın ilk sütunundaki veriyi getiriyor, ancak bu noktadan sonra kacıncı=1 oluyor ve diğer sütunlarda ilgili satırın sütun başlığını alıyor, diğer sütunlar için ne yapabilirim ?