Kodlar yavaş çalışıyor

[Mdemir63]

Selamlar
Sayfanın kod penceresindeki kodlarım yavaş çalışıyor. Sebebi ne olabilir ya da hızlı çalışabilmesi için kodlarda ne gibi değişiklik yapmak gerekir.

Saygılar

Private Sub Worksheet_SelectionChange(ByVal target As Range)
Dim a As String, say As Integer, i As Integer, say1 As Integer, say2 As Integer

Zaman = Timer


        If Intersect(target, [C2]) Is Nothing Then Exit Sub
             If Range("C2") = "" Then
                MsgBox "Lütfen Firma seçiniz..!", vbInformation
                Exit Sub
            End If

  a = Range("C2")
  say = 2:   say1 = 2:  say2 = 23

     For i = 3 To 23
        Range("C" & i) = Application.WorksheetFunction.VLookup(a, Worksheets("FirmaBilgileri").Range("B2:Z1000"), say, 0)
        say = say + 1

        Range("I" & i) = Application.WorksheetFunction.VLookup(a, Worksheets("ÜrünFiyatları").Range("B2:AR1000"), say1, 0)
        say1 = say1 + 1

        Range("F" & i) = Application.WorksheetFunction.VLookup(a, Worksheets("ÜrünFiyatları").Range("B2:AR1000"), say2, 0)
        say2 = say2 + 1
     Next i

          On Error Resume Next
   Range("M16") = WorksheetFunction.VLookup(a, Worksheets("Kontrol").Range("L2:Q200"), 2, 0)
   Range("M17") = WorksheetFunction.VLookup(a, Worksheets("Kontrol").Range("L2:Q200"), 3, 0)
   Range("M18") = WorksheetFunction.VLookup(a, Worksheets("Kontrol").Range("L2:Q200"), 4, 0)
   Range("M19") = WorksheetFunction.VLookup(a, Worksheets("Kontrol").Range("L2:Q200"), 5, 0)
   Range("J21") = WorksheetFunction.VLookup(a, Worksheets("Kontrol").Range("L2:Q200"), 6, 0)

   MsgBox "Sayın: " & Environ("username") & vbLf & "Firma Bilgileri Getirildi..!" & vbNewLine & _
   "İşlem Süresi: " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation, "BİLGİ MESAJI"
  
End Sub

 

[ÖmerFaruk]

Say, Say1,Say2 diye 3 ayrı değişken kullanmaktansa
For döngüsünün i değişkeniyle çözerim
Range("C"&i) satırında i-1
Range("I"&i) satırında i-1
Range("F"&i) satırında i+18

Say=Say+1 gibi olan satırları ve bu üç değişken tipini tanımlamalardan kaldırırım.

Alttaki 5 tane VlookUp yerine..
a değişkenine atadığım Range("C2") nin Kontrol sayfasında kaçıncı sırada olduğunu bulup M16 ya yazdıktan sonra, Offset fonksiyonuyla M17-M18..vb diğer hücreleri yazarım.

Ayrıca Range("C2") gidip yeniden bir string değişken tanımlamak yerine direkt kendisini kullanırım

 

[Mdemir63]

Selamlar
Hocam önerileriniz için çok teşekkür ederim.

Saygılar

 

[Necdet]

Merhaba,

Bir öneri daha :

Kodların başında Application.ScreenUpdating = False

Kodun sonunda ise False değerini True yapınız.

Böylelikle kodlar çalışırken ekrandaki değişimleri göstermemiş olursunuz, kodun çalışaması bittiğinde son durum zaten görüntülenecektir.

Özellikle büyük verilerde baya hız kazandırır bu yöntem.

 

[Mdemir63]

Selamlar
@Necdet abi teşekkür ederim.
Saygılar

 

[Mdemir63]

Selamlar
@NextLevel hocam önerilerinizin üst kısmındakileri yaptım. Ancak aşağıdaki kısımları yapamadım.
A değişkenine atadığım isimler Kontrol Sayfasında L2 hücresinden itibaren sıralanıyor. Ofset fonksiyonunu kullanamadım.

Saygılar


Alttaki 5 tane VlookUp yerine..
a değişkenine atadığım Range("C2") nin Kontrol sayfasında kaçıncı sırada olduğunu bulup M16 ya yazdıktan sonra, Offset fonksiyonuyla M17-M18..vb diğer hücreleri yazarım.

Ayrıca Range("C2") gidip yeniden bir string değişken tanımlamak yerine direkt kendisini kullanırım

 

[ÖmerFaruk]

Mesela bu olabilir.

   Bul = WorksheetFunction.Match(Range("C2"), Worksheets("Kontrol").Range("L2:L200"))
   Range("M16") = Worksheets("Kontrol").Cells(Bul, 14)
   Range("M17") = Worksheets("Kontrol").Cells(Bul, 15)
   Range("M18") = Worksheets("Kontrol").Cells(Bul, 16)
   Range("M19") = Worksheets("Kontrol").Cells(Bul, 17)
   Range("M21") = Worksheets("Kontrol").Cells(Bul, 18)

 

[Ömer]

Merhaba,

Alternatif olarak find komutunu kullanmanızı tavsiye ederim.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Dim Sf As Worksheet, Su As Worksheet, Sk As Worksheet, c As Range, d As Range, i As Byte, Zaman

    If Intersect(Target, [C2]) Is Nothing Then Exit Sub
    
    Set Sf = Sheets("FirmaBilgileri")
    Set Su = Sheets("ÜrünFiyatları")
    Set Sk = Sheets("Kontrol")
    
    With Application
        .ScreenUpdating = False
        .Calculation = xlManual
    End With
    
    If Target = "" Then
        MsgBox "Lütfen Firma seçiniz..!", vbInformation
        Exit Sub
    End If
    
    Zaman = Timer
    
    For i = 3 To 23
        Set c = Sf.Range("B1:B1000").Find(Target, , xlValues, xlWhole)
        If Not c Is Nothing Then
            Cells(i, "C") = Sf.Cells(c.Row, i)
            Cells(i, "I") = Sf.Cells(c.Row, i)
        End If
        Set d = Su.Range("B1:B1000").Find(Target, , xlValues, xlWhole)
        If Not d Is Nothing Then
            Cells(i, "F") = Su.Cells(d.Row, i + 21)
        End If
    Next i
    
    Set c = Sk.Range("L1:L200").Find(Target, , xlValues, xlWhole)
    If Not c Is Nothing Then
        Range("M16") = Sk.Cells(c.Row, "M")
        Range("M17") = Sk.Cells(c.Row, "N")
        Range("M18") = Sk.Cells(c.Row, "O")
        Range("M19") = Sk.Cells(c.Row, "P")
        Range("J21") = Sk.Cells(c.Row, "Q")
    End If

    MsgBox "Sayın: " & Environ("username") & vbLf & "Firma Bilgileri Getirildi..!" & vbNewLine & _
        "İşlem Süresi: " & Format(Timer - Zaman, "0.00") & " Saniye", vbInformation, "BİLGİ MESAJI"
        
    With Application
        .Calculation = xlAutomatic
        .ScreenUpdating = True
    End With
 
End Sub

 

[Mdemir63]

Selamlar
@NextLevel hocam son verdiğiniz kodlarla biraz daha hızlandı.

@Ömer hocam kodlarınızla çok hızlandı .

Emeği geçen herkese çok teşekkür ederim.

Saygılar