50.000 Satırlık Veride For Döngüsü Problemi

[kadir_2010]

Merhabalar,

Sheet1 : 43000 satırlık ana tablom var.(mağaza listesi)
Sheet4: 25000 satırlık satış raporu var.

düşeyara ya da etopla ile formül kurunca excel, kasmaktan çalışmaz hale geliyor.
bunun için for döngüsü kullandığımda ise 43000x25000=1,075,000,000 kez tarama yapmış oluyor ve haliyle bilgisayar uzun bi süre (yarım saatten fazla) cevap veremiyor.

Daha hızlı ya da etkili bir yöntem var mıdır, ilginiz için teşekkür ederim.

Sub satis()

For i = 2 To Sheet1.Range("A65536").End(xlUp).Row


'For j = 2 To Sheet4.Range("A65536").End(xlUp).Row
' Üstteki kodu aktif hale getirdiğimde 15 dakikada bile bitiremiyor.
For j = 2 To 3



If Sheet1.Cells(i, 1) = Sheet4.Cells(j, 1) And Sheet1.Cells(i, 2) = Sheet4.Cells(j, 2) Then
Sheet1.Cells(i, 5) = Sheet4.Cells(j, 3)
Exit For
End If

Next j
Next i


End Sub

 

[kadir_2010]

Tavsiyesi olan bir babayiğit yok mu =)

 

[Necdet]

Merhaba,

Veri fazla olduğunda yapılacak pek fazla bir şey yok. Ama küçük değişiklikle çalışma süresi biraz olsa kısaltılabilinir.

Her iki sayfada mağaza ve ürün adına göre sıralanırsa döngü sayısı biraz daha azalabilinir.

Sub Satis()
 
    Dim i   As Long, _
        c   As Range, _
        Adr As String, _
        shA As Worksheet, _
        shO As Worksheet
        
     Application.ScreenUpdating = False
     
     Set shA = Sheets("ANA TABLO")
     Set shO = Sheets("ocak satis")
     
     For i = 2 To shA.Cells(Rows.Count, "A").End(3).Row
     
        With shO.Range("A:A")
            Set c = .Find(shA.Cells(i, "A"), LookIn:=xlValues)
            If Not c Is Nothing Then
                Adr = c.Address
                Do
                    If shA.Cells(i, "B") = shO.Cells(c.Row, "B") Then shA.Cells(i, "E") = shO.Cells(c.Row, "C")
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> Adr
            End If
        End With
     
     Next i
     
     Application.ScreenUpdating = True
     
     MsgBox "İşlem Tamamlanmıştır...", vbInformation, "Excel.Web.Tr"
     
End Sub

 

[Zeki Gürsoy]

Merhaba,

İşlem süresi 2-3 sn. kadar sürüyor.
Teknik : Pivot table & SQL