excel vba- Döngü çok uzun sürüyor.

[exceling]

Arkadaşlar merhaba.
Excelde büyük veri ile çalışıyorum. Belli kriterlere göre belli satırları işaretlemem gereken aşağıdaki vba kodunu yazdım fakat kodum doğru olmasına rağmen verim çok büyük olduğu için sonuç alamıyorum. Bu konuyu acil çözmem gerekiyor. Lütfen yardımcı olur musunuz?

Sub makro ()
For i=2 to 11000
For t=2 to 500000
If Range("A"&i).Value=Range("D"&t).Value Then
If Range("B"&i).Value=Range("E"&t).Value Then
If Range("C"&i).Value=Range("F"&t).Value Then
Range("G"&i).Value="var"
End If
End If
End If
Next t
Next i
End Sub

 

[Korhan Ayhan]

Merhaba,

Büyük verilerde klasik döngüler oldukça yavaş kalacaktır. Bunun yerine ADO-Dictionary-Array tekniklerinden birisini kullanmanız avantaj sağlayacaktır.

Forumda bolca örnek var... Arama yaparsanız ulaşabilirsiniz.

 

[exceling]

Konuyla ilgili fazla bir bilgim olmadığı ve acil halletmem gerektiği için kodu yazmamda yardımcı olursanız çok memnun olurum.

 

[Korhan Ayhan]

Destek için küçültülmüş örnek dosya paylaşarak ne yapmak istediğinizi açıklamanız gerekir.

 

[exceling]

Dosya yükleyebileceğim bir yer göremedim. Yapmak istediğim şey şu.
Her biri 11 bin satırlık A, B ve C sütunlarım var. Yine her biri 500 bin satırlık D, E ve F sütunlarım var. A2=D2, B2=E2 ve C2=F2 ise G2 sütununa var yazsın. eğer değilse A2=D3, B2=E3 ve C2=F3'e baksın ve bulana kadar devam edip var yazdırıp A3'e geçsin. 500 bin satır için bunu kontrol etsin.


Sub makro ()
For i=2 to 11000
For t=2 to 500000
If Range("A"&i).Value=Range("D"&t).Value Then
If Range("B"&i).Value=Range("E"&t).Value Then
If Range("C"&i).Value=Range("F"&t).Value Then
Range("G"&i).Value="var"
End If
End If
End If
Next t
Next i
End Sub

 

[Korhan Ayhan]

Merhaba,

Foruma üye olurken karşınıza gelen ekranda uyarı amaçlı dosya yükleme-indirme işlemleri için ALTIN ÜYELİK gerektiği bilgisi geliyor. Sanırım buna dikkat etmediniz.

Dosya yüklemek için 2 alternatifiniz var.

1-ALTIN ÜYELİK
2-Harici dosya yükleme siteleri

 

[veyselemre]

Sub test()
    Dim veri, i&, ky$, son&
    Range("G2:H" & Rows.Count).ClearContents
    
    With CreateObject("Scripting.Dictionary")
        son = Cells(Rows.Count, "D").End(3).Row
        veri = Range("D2:F" & son).Value
        For i = LBound(veri) To UBound(veri)
            ky = veri(i, 1) & "|" & veri(i, 2) & "|" & veri(i, 3)
            .Item(ky) = .Item(ky) + 1
        Next i
        
        son = Cells(Rows.Count, "A").End(3).Row
        veri = Range("A2:C" & son).Value
        For i = LBound(veri) To UBound(veri)
            ky = veri(i, 1) & "|" & veri(i, 2) & "|" & veri(i, 3)
            If .exists(ky) Then
                veri(i, 1) = "Var"
                veri(i, 2) = .Item(ky)
            Else
                veri(i, 1) = "Yok"
                veri(i, 2) = ""
            End If
        Next i
    End With
    
    Range("G2:H2").Resize(UBound(veri), 2).Value = veri

End Sub

 

[exceling]

cevabınız içi teşekkür ederim fakat kod istediğim şekilde çalışmıyor. ben var mı yok mu diye kontrol yapmak istemiyorum. istediğim şey hangi satırda gerekli şartların sağlandığı. bu kodda 11bininci satıra kadar var yazıyor. ama ben bu şartların 500 bin satırlık kısım da hangi satırda sağlandığını vulmak istiyorum. umarım anlatabilmişimdir. ilginiz için teşekkürler.

 

[Korhan Ayhan]

Destek için küçültülmüş örnek dosya paylaşarak ne yapmak istediğinizi açıklamanız gerekir.

 

[dost]

Merhaba,

Sub Update_Column7()
    Dim adoCN As Object
    Dim strSQL, myFile As String
    
    Application.ScreenUpdating = False
    
    Set adoCN = CreateObject("ADODB.Connection")
        
    myFile = ThisWorkbook.FullName
    
    adoCN.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & myFile & _
      ";Extended Properties='Excel 12.0 Xml;HDR=NO';"
    
    strSQL = "UPDATE [Sheet1$] SET F7 = 'var' WHERE F1 = F4 AND F2 = F5 AND F3 = F6"
    
    adoCN.Execute strSQL
    
    adoCN.Close
    Set adoCN = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "İşlem tamamlandı...", vbInformation
    
End Sub