RE: Cari Adı, Vergi No, Tc No Sorgulama - feraz - 24/10/2020
Dur abey ayarlayayım bilgisayar açıp.
Re: Cari Adı, Vergi No, Tc No Sorgulama - feraz - 24/10/2020
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
RE: Cari Adı, Vergi No, Tc No Sorgulama - kanakan52 - 24/10/2020
(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.
RE: Cari Adı, Vergi No, Tc No Sorgulama - feraz - 24/10/2020
(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 ![Img-grin Img-grin](https://accesstr.net/images/smilies/img-grin.gif)
Yarın unutmazsam birde dictionary ve dizi ile yaparım örnek olması açısından.Tabii kodlar biraz uzar
RE: Cari Adı, Vergi No, Tc No Sorgulama - kanakan52 - 24/10/2020
(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 ![Img-grin Img-grin](https://accesstr.net/images/smilies/img-grin.gif)
Yarın unutmazsam birde dictionary ve dizi ile yaparım örnek olması açısından.Tabii kodlar biraz uzar ![Img-grin Img-grin](https://accesstr.net/images/smilies/img-grin.gif)
Ara verince unuttum bildiklerimi, cok birşey bildigim yok zaten. Paylaşırsan incelerim hocam. Iyiki varsınız.
RE: Cari Adı, Vergi No, Tc No Sorgulama - feraz - 25/10/2020
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.
![[Resim: do.php?img=10547]](https://resim.accesstr.net/do.php?img=10547)
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
|