24/10/2020, 22:57
Cari Adı, Vergi No, Tc No Sorgulama
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ı:Sendende abey.Kasma felan yapmaz çünkü döngü yok(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.
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ı:Sendende abey.Kasma felan yapmaz çünkü döngü yok(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.
Yarın unutmazsam birde dictionary ve dizi ile yaparım örnek olması açısından.Tabii kodlar biraz uzarAra 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.
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