• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Kodlar Çok Yavas Çalışıyor.

D

durakozgur

Katılım
24 Mayıs 2015
Mesajlar
4
Excel Vers. ve Dili
2007
Merhaba Dostlar,

Ben aşağıdaki gibi bir makro hazırladım fakat çok çok yavaş çalışıyor. Bana yardımcı olurmusunuz? Nasıl hızlandırmalıyım.

Teşekkür Ederim.


Sub Rapor15()
a = MsgBox("DOSYALARINDAN VERİ ALMAK İSTİYORMUSUNUZ.?", vbYesNo)
If a = vbNo Then
Exit Sub
End If
sat1 = 2
Range(Cells(2, 1), Cells(Rows.Count, Columns.Count)).Value = ""
Liste (ThisWorkbook.Path)
MsgBox "İŞLEM TAMAM"
End Sub
Private Sub Liste(Kalasor As String)
Dim fL As Object, f As Object, Dosya As String, j As Long
Set fL = CreateObject("Scripting.FileSystemObject").GetFolder(Kalasor).subfolders
Dim wb As Workbook
Dosya = Dir(Kalasor & "\*.xlsx")

While Dosya <> ""
DoEvents
If ThisWorkbook.Name <> Dosya Then
On Error Resume Next
Application.DisplayAlerts = False

deg = "'" & Kalasor & "\" & "[" & Dosya & "]" & "15" & "'!R" '//Veri alınacak dosyalardaki sayfa isimi

sat = Cells(Rows.Count, "A").End(3).Row + 1

Cells(sat, 1) = ExecuteExcel4Macro(deg & 2 & "C3")
Cells(sat, 2) = ExecuteExcel4Macro(deg & 5 & "C1")

Cells(sat, 3) = ExecuteExcel4Macro(deg & 7 & "C9")
Cells(sat, 4) = ExecuteExcel4Macro(deg & 7 & "C10")
Cells(sat, 5) = ExecuteExcel4Macro(deg & 7 & "C11")

Cells(sat, 6) = ExecuteExcel4Macro(deg & 10 & "C9")
Cells(sat, 7) = ExecuteExcel4Macro(deg & 10 & "C10")
Cells(sat, 8) = ExecuteExcel4Macro(deg & 10 & "C11")

Cells(sat, 9) = ExecuteExcel4Macro(deg & 11 & "C9")
Cells(sat, 10) = ExecuteExcel4Macro(deg & 11 & "C10")
Cells(sat, 11) = ExecuteExcel4Macro(deg & 11 & "C11")

Cells(sat, 12) = ExecuteExcel4Macro(deg & 12 & "C9")
Cells(sat, 13) = ExecuteExcel4Macro(deg & 12 & "C10")
Cells(sat, 14) = ExecuteExcel4Macro(deg & 12 & "C11")

Cells(sat, 15) = ExecuteExcel4Macro(deg & 13 & "C9")
Cells(sat, 16) = ExecuteExcel4Macro(deg & 13 & "C10")
Cells(sat, 17) = ExecuteExcel4Macro(deg & 13 & "C11")

Cells(sat, 18) = ExecuteExcel4Macro(deg & 8 & "C9")
Cells(sat, 19) = ExecuteExcel4Macro(deg & 8 & "C10")
Cells(sat, 20) = ExecuteExcel4Macro(deg & 8 & "C11")

Cells(sat, 21) = ExecuteExcel4Macro(deg & 9 & "C9")
Cells(sat, 22) = ExecuteExcel4Macro(deg & 9 & "C10")
Cells(sat, 23) = ExecuteExcel4Macro(deg & 9 & "C11")

Cells(sat, 24) = ExecuteExcel4Macro(deg & 3 & "C4")
Cells(sat, 25) = ExecuteExcel4Macro(deg & 2 & "C9")
Cells(sat, 26) = ExecuteExcel4Macro(deg & 2 & "C10")
Cells(sat, 27) = ExecuteExcel4Macro(deg & 2 & "C11")

Cells(sat, 28) = ExecuteExcel4Macro(deg & 3 & "C9")
Cells(sat, 29) = ExecuteExcel4Macro(deg & 3 & "C10")
Cells(sat, 30) = ExecuteExcel4Macro(deg & 3 & "C11")

Cells(sat, 31) = ExecuteExcel4Macro(deg & 4 & "C9")
Cells(sat, 32) = ExecuteExcel4Macro(deg & 4 & "C10")
Cells(sat, 33) = ExecuteExcel4Macro(deg & 4 & "C11")

Cells(sat, 34) = ExecuteExcel4Macro(deg & 5 & "C9")
Cells(sat, 35) = ExecuteExcel4Macro(deg & 5 & "C10")
Cells(sat, 36) = ExecuteExcel4Macro(deg & 5 & "C11")

Cells(sat, 37) = ExecuteExcel4Macro(deg & 17 & "C9")
Cells(sat, 38) = ExecuteExcel4Macro(deg & 17 & "C10")
Cells(sat, 39) = ExecuteExcel4Macro(deg & 17 & "C11")

Cells(sat, 40) = ExecuteExcel4Macro(deg & 18 & "C9")
Cells(sat, 41) = ExecuteExcel4Macro(deg & 18 & "C10")
Cells(sat, 42) = ExecuteExcel4Macro(deg & 18 & "C11")

Cells(sat, 43) = ExecuteExcel4Macro(deg & 19 & "C9")
Cells(sat, 44) = ExecuteExcel4Macro(deg & 19 & "C10")
Cells(sat, 45) = ExecuteExcel4Macro(deg & 19 & "C11")

Cells(sat, 46) = ExecuteExcel4Macro(deg & 20 & "C9")
Cells(sat, 47) = ExecuteExcel4Macro(deg & 20 & "C10")
Cells(sat, 48) = ExecuteExcel4Macro(deg & 20 & "C11")

Cells(sat, 49) = ExecuteExcel4Macro(deg & 21 & "C9")
Cells(sat, 50) = ExecuteExcel4Macro(deg & 21 & "C10")
Cells(sat, 51) = ExecuteExcel4Macro(deg & 21 & "C11")

Cells(sat, 52) = ExecuteExcel4Macro(deg & 22 & "C9")
Cells(sat, 53) = ExecuteExcel4Macro(deg & 22 & "C10")
Cells(sat, 54) = ExecuteExcel4Macro(deg & 22 & "C11")

Cells(sat, 55) = ExecuteExcel4Macro(deg & 23 & "C9")
Cells(sat, 56) = ExecuteExcel4Macro(deg & 23 & "C10")
Cells(sat, 57) = ExecuteExcel4Macro(deg & 23 & "C11")

Cells(sat, 58) = ExecuteExcel4Macro(deg & 24 & "C9")
Cells(sat, 59) = ExecuteExcel4Macro(deg & 24 & "C10")
Cells(sat, 60) = ExecuteExcel4Macro(deg & 24 & "C11")

Cells(sat, 61) = ExecuteExcel4Macro(deg & 25 & "C9")
Cells(sat, 62) = ExecuteExcel4Macro(deg & 25 & "C10")
Cells(sat, 63) = ExecuteExcel4Macro(deg & 25 & "C11")

Cells(sat, 64) = ExecuteExcel4Macro(deg & 26 & "C9")
Cells(sat, 65) = ExecuteExcel4Macro(deg & 26 & "C10")
Cells(sat, 66) = ExecuteExcel4Macro(deg & 26 & "C11")

Cells(sat, 67) = ExecuteExcel4Macro(deg & 27 & "C9")
Cells(sat, 68) = ExecuteExcel4Macro(deg & 27 & "C10")
Cells(sat, 69) = ExecuteExcel4Macro(deg & 27 & "C11")

Cells(sat, 70) = ExecuteExcel4Macro(deg & 28 & "C9")
Cells(sat, 71) = ExecuteExcel4Macro(deg & 28 & "C10")
Cells(sat, 72) = ExecuteExcel4Macro(deg & 28 & "C11")

Cells(sat, 73) = ExecuteExcel4Macro(deg & 29 & "C9")
Cells(sat, 74) = ExecuteExcel4Macro(deg & 29 & "C10")
Cells(sat, 75) = ExecuteExcel4Macro(deg & 29 & "C11")

Cells(sat, 76) = ExecuteExcel4Macro(deg & 30 & "C9")
Cells(sat, 77) = ExecuteExcel4Macro(deg & 30 & "C10")
Cells(sat, 78) = ExecuteExcel4Macro(deg & 30 & "C11")

Cells(sat, 79) = ExecuteExcel4Macro(deg & 31 & "C9")
Cells(sat, 80) = ExecuteExcel4Macro(deg & 31 & "C10")
Cells(sat, 81) = ExecuteExcel4Macro(deg & 31 & "C11")

Cells(sat, 82) = ExecuteExcel4Macro(deg & 6 & "C9")
Cells(sat, 83) = ExecuteExcel4Macro(deg & 6 & "C10")
Cells(sat, 84) = ExecuteExcel4Macro(deg & 6 & "C11")



'hatalar

Cells(sat, 88) = ExecuteExcel4Macro(deg & 35 & "C9")
Cells(sat, 89) = ExecuteExcel4Macro(deg & 35 & "C10")
Cells(sat, 90) = ExecuteExcel4Macro(deg & 35 & "C11")

Cells(sat, 91) = ExecuteExcel4Macro(deg & 36 & "C9")
Cells(sat, 92) = ExecuteExcel4Macro(deg & 36 & "C10")
Cells(sat, 93) = ExecuteExcel4Macro(deg & 36 & "C11")

Cells(sat, 94) = ExecuteExcel4Macro(deg & 37 & "C9")
Cells(sat, 95) = ExecuteExcel4Macro(deg & 37 & "C10")
Cells(sat, 96) = ExecuteExcel4Macro(deg & 37 & "C11")

Cells(sat, 97) = ExecuteExcel4Macro(deg & 38 & "C9")
Cells(sat, 98) = ExecuteExcel4Macro(deg & 38 & "C10")
Cells(sat, 99) = ExecuteExcel4Macro(deg & 38 & "C11")

Cells(sat, 100) = ExecuteExcel4Macro(deg & 39 & "C9")
Cells(sat, 101) = ExecuteExcel4Macro(deg & 39 & "C10")
Cells(sat, 102) = ExecuteExcel4Macro(deg & 39 & "C11")

Cells(sat, 103) = ExecuteExcel4Macro(deg & 40 & "C9")
Cells(sat, 104) = ExecuteExcel4Macro(deg & 40 & "C10")
Cells(sat, 105) = ExecuteExcel4Macro(deg & 40 & "C11")

Cells(sat, 106) = ExecuteExcel4Macro(deg & 41 & "C9")
Cells(sat, 107) = ExecuteExcel4Macro(deg & 41 & "C10")
Cells(sat, 108) = ExecuteExcel4Macro(deg & 41 & "C11")

Cells(sat, 109) = ExecuteExcel4Macro(deg & 42 & "C9")
Cells(sat, 110) = ExecuteExcel4Macro(deg & 42 & "C10")
Cells(sat, 111) = ExecuteExcel4Macro(deg & 42 & "C11")

Cells(sat, 112) = ExecuteExcel4Macro(deg & 43 & "C9")
Cells(sat, 113) = ExecuteExcel4Macro(deg & 43 & "C10")
Cells(sat, 114) = ExecuteExcel4Macro(deg & 43 & "C11")

Cells(sat, 115) = ExecuteExcel4Macro(deg & 44 & "C9")
Cells(sat, 116) = ExecuteExcel4Macro(deg & 44 & "C10")
Cells(sat, 117) = ExecuteExcel4Macro(deg & 44 & "C11")

Cells(sat, 118) = ExecuteExcel4Macro(deg & 45 & "C9")
Cells(sat, 119) = ExecuteExcel4Macro(deg & 45 & "C10")
Cells(sat, 120) = ExecuteExcel4Macro(deg & 45 & "C11")

Cells(sat, 121) = ExecuteExcel4Macro(deg & 46 & "C9")
Cells(sat, 122) = ExecuteExcel4Macro(deg & 46 & "C10")
Cells(sat, 123) = ExecuteExcel4Macro(deg & 46 & "C11")

Cells(sat, 124) = ExecuteExcel4Macro(deg & 47 & "C9")
Cells(sat, 125) = ExecuteExcel4Macro(deg & 47 & "C10")
Cells(sat, 126) = ExecuteExcel4Macro(deg & 47 & "C11")

Cells(sat, 127) = ExecuteExcel4Macro(deg & 48 & "C9")
Cells(sat, 128) = ExecuteExcel4Macro(deg & 48 & "C10")
Cells(sat, 129) = ExecuteExcel4Macro(deg & 48 & "C11")

Cells(sat, 130) = ExecuteExcel4Macro(deg & 49 & "C9")
Cells(sat, 131) = ExecuteExcel4Macro(deg & 49 & "C10")
Cells(sat, 132) = ExecuteExcel4Macro(deg & 49 & "C11")

Cells(sat, 133) = ExecuteExcel4Macro(deg & 50 & "C9")
Cells(sat, 134) = ExecuteExcel4Macro(deg & 50 & "C10")
Cells(sat, 135) = ExecuteExcel4Macro(deg & 50 & "C11")

Cells(sat, 136) = ExecuteExcel4Macro(deg & 51 & "C9")
Cells(sat, 137) = ExecuteExcel4Macro(deg & 51 & "C10")
Cells(sat, 138) = ExecuteExcel4Macro(deg & 51 & "C11")

Cells(sat, 139) = ExecuteExcel4Macro(deg & 52 & "C9")
Cells(sat, 140) = ExecuteExcel4Macro(deg & 52 & "C10")
Cells(sat, 141) = ExecuteExcel4Macro(deg & 52 & "C11")

Cells(sat, 142) = ExecuteExcel4Macro(deg & 53 & "C9")
Cells(sat, 143) = ExecuteExcel4Macro(deg & 53 & "C10")
Cells(sat, 144) = ExecuteExcel4Macro(deg & 53 & "C11")

Cells(sat, 145) = ExecuteExcel4Macro(deg & 54 & "C9")
Cells(sat, 146) = ExecuteExcel4Macro(deg & 54 & "C10")
Cells(sat, 147) = ExecuteExcel4Macro(deg & 54 & "C11")

Cells(sat, 148) = ExecuteExcel4Macro(deg & 55 & "C9")
Cells(sat, 149) = ExecuteExcel4Macro(deg & 55 & "C10")
Cells(sat, 150) = ExecuteExcel4Macro(deg & 55 & "C11")

Cells(sat, 151) = ExecuteExcel4Macro(deg & 56 & "C9")
Cells(sat, 152) = ExecuteExcel4Macro(deg & 56 & "C10")
Cells(sat, 153) = ExecuteExcel4Macro(deg & 56 & "C11")

Cells(sat, 154) = ExecuteExcel4Macro(deg & 57 & "C9")
Cells(sat, 155) = ExecuteExcel4Macro(deg & 57 & "C10")
Cells(sat, 156) = ExecuteExcel4Macro(deg & 57 & "C11")

Cells(sat, 157) = ExecuteExcel4Macro(deg & 58 & "C9")
Cells(sat, 158) = ExecuteExcel4Macro(deg & 58 & "C10")
Cells(sat, 159) = ExecuteExcel4Macro(deg & 58 & "C11")

Cells(sat, 160) = ExecuteExcel4Macro(deg & 59 & "C9")
Cells(sat, 161) = ExecuteExcel4Macro(deg & 59 & "C10")
Cells(sat, 162) = ExecuteExcel4Macro(deg & 59 & "C11")

End If
Dosya = Dir
Wend
On Error GoTo sonraki
For Each f In fL
Kalasor = f.Path
Liste (f.Path)
sonraki:
Next
Set fL = Nothing
Application.ScreenUpdating = True
End Sub
 
Son düzenleme:
Merhaba,

Örnek dosya ekleyebilir misiniz.
Bu şekilde cevap alamama ihtimaliniz yüksek.
 
Ekli dosya konusunda yardım eder misiniz?

Ekli dosya konusunda yardım eder misiniz?

Teşekkür ederim.
 
"ExecuteExcel4Macro" yu defalarca kullanmak hata. Bu, dosyayı arka arkaya açmak gibi olur. Fonksiyon bunun için yapılmamıştır sanıyorum.

Dosyayı fiziksel olarak açtırarak veri alın veya ADO metodunu kullanın.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst