+- AccessTr.neT (https://accesstr.net)
+-- Forum: Microsoft Excel (https://accesstr.net/forum-microsoft-excel.html)
+--- Forum: Excel Cevaplanmış Soruları (https://accesstr.net/forum-excel-cevaplanmis-sorulari.html)
+--- Konu Başlığı: Cari Adı, Vergi No, Tc No Sorgulama (/konu-cari-adi-vergi-no-tc-no-sorgulama.html)
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 IfRE: 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ı: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
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ı: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
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.
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