Cari Adı, Vergi No, Tc No Sorgulama

1 2 3 4 5 6
24/10/2020, 22:57

feraz

Dur abey ayarlayayım bilgisayar açıp.
24/10/2020, 23:06

feraz

 If kacinci > 1 Then
MsgBox "ilgili veri bulundu", vbInformation, "mükerrer"
Application.EnableEvents = False
Cells(satir, 1).Value = Sayfa2.Cells(kacinci, 1).Value
Cells(satir, 6).Value = Sayfa2.Cells(kacinci, 9).Value
Application.EnableEvents = True
End If
24/10/2020, 23:13

kanakan52

(24/10/2020, 23:06)feraz yazdı:
 If kacinci > 1 Then
        MsgBox "ilgili veri bulundu", vbInformation, "mükerrer"
        Application.EnableEvents = False
        Cells(satir, 1).Value = Sayfa2.Cells(kacinci, 1).Value
        Cells(satir, 6).Value = Sayfa2.Cells(kacinci, 9).Value
        Application.EnableEvents = True
    End If

Allah razı olsun hocam, yine büyük bir dertten kurtardın beni. Eğer kasmaz ise çok güzel olacak. Tekrar tekrar teşekkür ederim.
24/10/2020, 23:20

feraz

(24/10/2020, 23:13)kanakan52 yazdı:
(24/10/2020, 23:06)feraz yazdı:
 If kacinci > 1 Then
        MsgBox "ilgili veri bulundu", vbInformation, "mükerrer"
        Application.EnableEvents = False
        Cells(satir, 1).Value = Sayfa2.Cells(kacinci, 1).Value
        Cells(satir, 6).Value = Sayfa2.Cells(kacinci, 9).Value
        Application.EnableEvents = True
    End If

Allah razı olsun hocam, yine büyük bir  dertten kurtardın beni. Eğer kasmaz ise çok güzel olacak. Tekrar tekrar teşekkür ederim.
Sendende abey.Kasma felan yapmaz çünkü döngü yok
Yarın unutmazsam birde dictionary ve dizi ile yaparım örnek olması açısından.Tabii kodlar biraz uzar
24/10/2020, 23:43

kanakan52

(24/10/2020, 23:20)feraz yazdı:
(24/10/2020, 23:13)kanakan52 yazdı:
(24/10/2020, 23:06)feraz yazdı:
 If kacinci > 1 Then
        MsgBox "ilgili veri bulundu", vbInformation, "mükerrer"
        Application.EnableEvents = False
        Cells(satir, 1).Value = Sayfa2.Cells(kacinci, 1).Value
        Cells(satir, 6).Value = Sayfa2.Cells(kacinci, 9).Value
        Application.EnableEvents = True
    End If

Allah razı olsun hocam, yine büyük bir  dertten kurtardın beni. Eğer kasmaz ise çok güzel olacak. Tekrar tekrar teşekkür ederim.
Sendende abey.Kasma felan yapmaz çünkü döngü yok
Yarın unutmazsam birde dictionary ve dizi ile yaparım örnek olması açısından.Tabii kodlar biraz uzar Ara verince unuttum bildiklerimi, cok birşey bildigim yok zaten. Paylaşırsan incelerim hocam. Iyiki varsınız.
25/10/2020, 00:17

feraz

Kodlar altta abey.Resimdeki sarıya boyadığım yer seçilmeli.
Belki bu daha hızlı çalışır.Dictionary ce dizi ikilisi müthiş hızlı çalılıyor beraber.


Private Sub Worksheet_Change(ByVal Target As Range)
    Dim satir As Long, sutun As Byte, aranan, hedefsutun As String
    Dim dictt As Dictionary

    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: Set dictt = dictBul(2)
            Case 6: satir = Target.Row: sutun = Target.Column: aranan = Target.Value: Set dictt = dictBul(9)
            Case 18: satir = Target.Row: sutun = Target.Column: aranan = Target.Value: Set dictt = dictBul(8)
        End Select
        varmi sutun, hedefsutun, satir, aranan, dictt
    End If
    Set dictt = Nothing
End Sub

Function varmi(alan As Byte, aranansutun As String, satir As Long, aranan, dict As Dictionary)
  Dim kacinci As Long
    If satir > 1 Then
        If Trim(Cells(satir, alan).Value) <> "" Then
            If Cells(satir, alan).Cells.Count = 1 Then kacinci = dict(CStr(aranan)) + 1
        End If
    End If
   
    If kacinci > 1 Then
        MsgBox "ilgili veri bulundu", vbInformation, "mükerrer"
        Application.EnableEvents = False
        Cells(satir, 1).Value = Sayfa2.Cells(kacinci, 1).Value
        Cells(satir, 6).Value = Sayfa2.Cells(kacinci, 9).Value
        Application.EnableEvents = True
    End If
    Set bul = Nothing
End Function



Function dictBul(aralik As Byte) As Dictionary
    Dim dict As New Dictionary, dizi(), son As Long, i As Long
    son = Sayfa2.Range("A" & Rows.Count).End(3).Row
    If son < 2 Then son = 2
    dizi = Sayfa2.Range("a2:i" & son).Value
    For i = LBound(dizi) To UBound(dizi)
        If Not dict.Exists(CStr(dizi(i, aralik))) Then dict.Add CStr(dizi(i, aralik)), i
    Next
    Set dictBul = dict: Erase dizi
End Function
1 2 3 4 5 6