makroyu hızlandırmak için yardım..

[regdtee]

gönderdiğim örnekteki gibi bi makro yazdım ama adet fazla olduğu zaman çok uzun sürede işlemi gerçekleştiriyor. yani süreç sayfası 30 bin rapor sayfasındaki sicil sayısıda 500 civarında olduğunda çalışması çok uzun sürüyor.
buna benzer bir işlemi excel özet tablodan çok kısa sürede yapabildiğine göre öyle tahmin ediyorum makroda farklı yazılırsa çok kısa sürede yapar ??
konuyla ilgili yardımlarınız için şimdiden teşekkür edrim.

 

[Zeki Gürsoy]

SQL deneyin...

Not: Dosyanızın kullanım alanı çok geniş; CTRL + End ile 25 binli satırlara iniyor. Bu, SQL sorgusunun dosyanızda hali hazır 1000 veri için değil, 25 bin satır için sorgu yapması demektir.
1000' den sonraki boş satırları silip dosyanızı A1 hücresi seçili iken kaydedin.

Sub SQL_Perf()
Dim cn As Object, rs As Object, tmp As Object
Dim r1 As Range, r2 As Range, r3 As Range, s As Long

Sheets("rapor").Range("a3:ad100000").ClearContents

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

[COLOR=DarkGreen]'Excel 2007/2010 için ODBC connection string'i...[/COLOR]
cn.Open _
"Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};" & _
"DBQ=" & ThisWorkbook.FullName

Set tmp = cn.Execute( _
"SELECT DISTINCT SICIL FROM [sürec$]")

Sheets("rapor").[A3].CopyFromRecordset tmp

Set tmp = Nothing

DoEvents

rs.Open _
    "SELECT Y.SICIL, Y.URUN, Count(Y.BITISTARIHI) AS NORMAL," & _
        "(SELECT Count(Z.BITISTARIHI) " & _
        "FROM [sürec$] AS Z " & _
        "WHERE Hour(Z.BITISTARIHI) >= 18 And Z.SICIL = Y.SICIL And Z.URUN = Y.URUN) as MESAI " & _
    "FROM [sürec$] as Y " & _
    "WHERE Hour(Y.BITISTARIHI) < 18 " & _
    "GROUP BY Y.SICIL, Y.URUN", cn, 1, 3

s = Sheets("rapor").Range("a100000").End(3).Row

Do While Not rs.EOF
    DoEvents 

    Set r1 = Sheets("rapor").Range("a2:a" & s).Find(rs(0).Value)
    Set r2 = Sheets("rapor").Range("a2:o2").Find(rs(1).Value)
    Set r3 = Sheets("rapor").Range("p2:ad2").Find(rs(1).Value)
   
    Sheets("rapor").Cells(r1.Row, r2.Column).Value = rs(2)
    Sheets("rapor").Cells(r1.Row, r3.Column).Value = rs(3)
    rs.movenext
Loop

rs.close
cn.Close

Set rs = Nothing
Set cn = Nothing

MsgBox "Bitti"
End Sub

 

[regdtee]

vba tam olarak kullanmayı bilmiyorum, kendimce bişiler yazmaya çalışıyorum sql hiç bilmiyorum, gönderdiğinizi biraz inceledim ama çok farklı sanırım. yazdığınız kodları kopyalayıp çalıştırdığım zaman tam sayıyı vermedi.süreç sayfasında 1000 satır var (bahsettiğiniz boş satırlarıda sildim) ama rapor sayfasında 840 gibi bir rakam çıkarıyor. yardımlarınız için teşekkür ederim.