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
