Sorgu hızlandırma

Katılım
13 Aralık 2006
Mesajlar
55
Excel Vers. ve Dili
office 2003
Arkadaşlar merhaba, kullandığım tabloda iki sütun aşağıdaki kodları kullanarak sorgulama yaparak sonucu ilgili hücreye yazmakta, fakat sorgu satırı 800 civarında olduğu ve iki farklı sorgu olduğu için malumunuz çok bekletmekte işimi kolaylaştırmak yerine daha da uzatmakta, bu sorguyu nasıl hızlandırabilirim veya daha değişik ne kullanabilirim, ilgi gösteren göstermeyen herkese çok teşekkür..

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [B2:B800]) Is Nothing Then Exit Sub
For ara = 1 To 800
Range("I" & ara) = WorksheetFunction.VLookup(Range("B" & ara), Range("N:O"), 2, 0)
Range("F" & ara) = WorksheetFunction.VLookup(Range("B" & ara), Range("N:p"), 3, 0)
If Range("B" & ara) = "" Then
Range("B" & ara).Offset(0, 1) = ""
Range("B" & ara).Offset(0, 2) = ""
End If
Next
End Sub
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
Niye B sütunundaki herhengi bir hücreye veri girdiğinizde 800 defa döngüye giripte bütün bu hücreler veri aktarıyorsunuz?
yalnızca işlem yaptığnız hücreye ait satırda işlem yapsanız yavaşlama ortadan kalkacak ve çok hızlı bir işlem olacaktır.:cool:
 
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
Sanırım, kısır bir döngüde, birbirini tetikleyen olaylara hükmedemeyen kodunuz olduğu için, bu tür yavaşlama söz konusu .... Amma cümle kurdum ya :)

Yani, siz manuel olarak B sütununda bir değişiklik olduğunda kodunuzun çalışmasını istiyorsunuz ama döngü de, B sütunundaki hücreleri değiştirdiği için prosedür tekrar tekrar çalışmakta ....

Bu durumda, Excel'i tetikleyen olayları bir süreliğine durdurmanız gerekir.

Kodu aşağıdaki gibi değiştirip deneyiniz. Eklenenler, kırmızı renk ile gösterilmiştir.

Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
    On Error Resume Next
    If Intersect(Target, [B2:B800]) Is Nothing Then Exit Sub
    
[COLOR=red]    Application.EnableEvents = False[/COLOR]
    
    For ara = 1 To 800
        Range("I" & ara) = WorksheetFunction.VLookup(Range("B" & ara), Range("N:O"), 2, 0)
        Range("F" & ara) = WorksheetFunction.VLookup(Range("B" & ara), Range("N:P"), 3, 0)
        If Range("B" & ara) = "" Then
            Range("B" & ara).Offset(0, 1) = ""
            Range("B" & ara).Offset(0, 2) = ""
        End If
    Next
    
[COLOR=red]    Application.EnableEvents = True[/COLOR]
 
End Sub
 
Katılım
13 Aralık 2006
Mesajlar
55
Excel Vers. ve Dili
office 2003
:) Sn.Gizlen ve Sn.Pazarçevirdi ilginize teşekkür ederim, B sütununa plaka no giriyorum ve sorgu plakaya göre F sütununa şöförü I sütununa da firmasını yazmakta malum bu verilerde 800 satır civarı devam etmekte, yani tabloya her farklı plaka girdiğimde tekrar sorgu yapmak zorunda..,Sn.Pazarçevirdi düzenlemenizi kullandım fakat bir değişiklik olmadı..
 
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
Ama; siz, tek bir tuşa basarak, Excel'de 3.200 adet hücrenin değerini değiştiriyorsunuz. Bu da tabi ki, zaman alacaktır.

Örnek bir dosya ile ne yapmak istediğinizi tekrar anlatınız.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
:) Sn.Gizlen ve Sn.Pazarçevirdi ilginize teşekkür ederim, B sütununa plaka no giriyorum ve sorgu plakaya göre F sütununa şöförü I sütununa da firmasını yazmakta malum bu verilerde 800 satır civarı devam etmekte, yani tabloya her farklı plaka girdiğimde tekrar sorgu yapmak zorunda..,Sn.Pazarçevirdi düzenlemenizi kullandım fakat bir değişiklik olmadı..
Birde aşağıdaki kodları denermisiniz?.:cool:
Kod:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Intersect(Target, [B2:B800]) Is Nothing Then Exit Sub
    If Target.Value = "" Then
        Target.Offset(0, 1).Value = ""
        Target.Offset(0, 2).Value = ""
        Else
        Range("I" & Target.Row) = WorksheetFunction.VLookup(Range("B" & Target.Row), Range("N:O"), 2, 0)
        Range("F" & Target.Row) = WorksheetFunction.VLookup(Range("B" & Target.Row), Range("N:P"), 3, 0)
    End If
End Sub
 
Katılım
13 Aralık 2006
Mesajlar
55
Excel Vers. ve Dili
office 2003
İşte bu kadar sn.gizlen, düzenlediğiniz kodlar bekletmeden ve gayet güzel çalışmakta, ilgilendiğiniz ve yardımlarınız için her ikinizede çok teşekkür ederim.
 

Orion1

Uzman
Uzman
Katılım
1 Mart 2005
Mesajlar
22,254
Excel Vers. ve Dili
Win7 Home Basic TR 64 Bit

Ofis-2010-TR 32 Bit
İşte bu kadar sn.gizlen, düzenlediğiniz kodlar bekletmeden ve gayet güzel çalışmakta, ilgilendiğiniz ve yardımlarınız için her ikinizede çok teşekkür ederim.
Rica ederim.
İyi çalışmalar.:cool:
 
Üst