Skip to main content

AccessTr.neT


Cari Adı, Vergi No, Tc No Sorgulama

Cari Adı, Vergi No, Tc No Sorgulama

#13
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

[Resim: do.php?img=10546]
Cevapla
#14
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
Cevapla
#15
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
.rar CARİ DENEME.rar (Dosya Boyutu: 20,93 KB | İndirme Sayısı: 4)
Cevapla
Thumbs Up #16
(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.
Son Düzenleme: 24/10/2020, 22:26, Düzenleyen: kanakan52.
Cevapla
#17
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 Img-grin

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 Img-grin
Cevapla
#18
(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 Img-grin

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 Img-grin

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 ?
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da