• DİKKAT

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

Gelişmiş Modda veri çekme

Katılım
25 Ağustos 2012
Mesajlar
562
Excel Vers. ve Dili
Office 2003
Herkese kolay gelsin
Ekteki dosyamda açıklamaya çalıştım
depo sayfasından çizelgeme kritere göre veri çekmek istiyorum. Bunu formülle yaptığım zaman buna benzer çizelgelerimin çokluğu nedeniyle dosya boyutu büyüyor ve işlem yavaşlıyor. Bunu Makro kodu ile yapılabilirmi?
 

Ekli dosyalar

Son düzenleme:
Konu günceldir yardımlarınızı bekliyorum Lütfen
 
Son düzenleme:
Şu kodu denermisiniz..

Kod:
Sub verilerigetir()
Sheets("EK1F").Range("D13:S39").ClearContents

xx = 0
For MSTF1 = 13 To 32
If xx > 5 Then
xx = 0
End If
For MSTF2 = 10 To Sheets("DEPO7").Cells(65536, "A").End(xlUp).Row
If Sheets("EK1F").Cells(MSTF1, "B") = Sheets("DEPO7").Cells(MSTF2, "C") Then
If Sheets("EK1F").Cells(MSTF1 - xx, "C") = Sheets("DEPO7").Cells(MSTF2, "A") Then
For MM = 4 To 14
Sheets("EK1F").Cells(MSTF1, MM) = Sheets("DEPO7").Cells(MSTF2, MM + 11)
Sheets("EK1F").Cells(MSTF1, "O") = Sheets("EK1F").Cells(MSTF1, "O") + Sheets("DEPO7").Cells(MSTF2, MM + 11)
Sheets("EK1F").Cells(38, MM) = Sheets("EK1F").Cells(38, MM) + Sheets("DEPO7").Cells(MSTF2, MM + 11)
Next
Sheets("EK1F").Cells(MSTF1, "P") = Sheets("DEPO7").Cells(MSTF2, "H")
Sheets("EK1F").Cells(MSTF1, "Q") = Sheets("DEPO7").Cells(MSTF2, "I")
Sheets("EK1F").Cells(MSTF1, "R") = Sheets("EK1F").Cells(MSTF1, "R") + Sheets("DEPO7").Cells(MSTF2, "H") + Sheets("DEPO7").Cells(MSTF2, "I")

Sheets("EK1F").Cells(38, "O") = Sheets("EK1F").Cells(38, "O") + Sheets("DEPO7").Cells(MSTF2, MM + 11)
Sheets("EK1F").Cells(38, "P") = Sheets("EK1F").Cells(38, "P") + Sheets("DEPO7").Cells(MSTF2, "H")
Sheets("EK1F").Cells(38, "Q") = Sheets("EK1F").Cells(38, "Q") + Sheets("DEPO7").Cells(MSTF2, "I")


End If
End If

Next
Sheets("EK1F").Cells(MSTF1, "S") = Sheets("EK1F").Cells(MSTF1, "O") + Sheets("EK1F").Cells(MSTF1, "R")
Sheets("EK1F").Cells(38, "R") = Sheets("EK1F").Cells(38, "R") + Sheets("EK1F").Cells(MSTF1, "R")
Sheets("EK1F").Cells(38, "S") = Sheets("EK1F").Cells(38, "S") + Sheets("EK1F").Cells(MSTF1, "S")
xx = xx + 1
Next


End Sub
 
Şu kodu denermisiniz..

Kod:
Sub verilerigetir()
Sheets("EK1F").Range("D13:S39").ClearContents

xx = 0
For MSTF1 = 13 To 32
If xx > 5 Then
xx = 0
End If
For MSTF2 = 10 To Sheets("DEPO7").Cells(65536, "A").End(xlUp).Row
If Sheets("EK1F").Cells(MSTF1, "B") = Sheets("DEPO7").Cells(MSTF2, "C") Then
If Sheets("EK1F").Cells(MSTF1 - xx, "C") = Sheets("DEPO7").Cells(MSTF2, "A") Then
For MM = 4 To 14
Sheets("EK1F").Cells(MSTF1, MM) = Sheets("DEPO7").Cells(MSTF2, MM + 11)
Sheets("EK1F").Cells(MSTF1, "O") = Sheets("EK1F").Cells(MSTF1, "O") + Sheets("DEPO7").Cells(MSTF2, MM + 11)
Sheets("EK1F").Cells(38, MM) = Sheets("EK1F").Cells(38, MM) + Sheets("DEPO7").Cells(MSTF2, MM + 11)
Next
Sheets("EK1F").Cells(MSTF1, "P") = Sheets("DEPO7").Cells(MSTF2, "H")
Sheets("EK1F").Cells(MSTF1, "Q") = Sheets("DEPO7").Cells(MSTF2, "I")
Sheets("EK1F").Cells(MSTF1, "R") = Sheets("EK1F").Cells(MSTF1, "R") + Sheets("DEPO7").Cells(MSTF2, "H") + Sheets("DEPO7").Cells(MSTF2, "I")

Sheets("EK1F").Cells(38, "O") = Sheets("EK1F").Cells(38, "O") + Sheets("DEPO7").Cells(MSTF2, MM + 11)
Sheets("EK1F").Cells(38, "P") = Sheets("EK1F").Cells(38, "P") + Sheets("DEPO7").Cells(MSTF2, "H")
Sheets("EK1F").Cells(38, "Q") = Sheets("EK1F").Cells(38, "Q") + Sheets("DEPO7").Cells(MSTF2, "I")


End If
End If

Next
Sheets("EK1F").Cells(MSTF1, "S") = Sheets("EK1F").Cells(MSTF1, "O") + Sheets("EK1F").Cells(MSTF1, "R")
Sheets("EK1F").Cells(38, "R") = Sheets("EK1F").Cells(38, "R") + Sheets("EK1F").Cells(MSTF1, "R")
Sheets("EK1F").Cells(38, "S") = Sheets("EK1F").Cells(38, "S") + Sheets("EK1F").Cells(MSTF1, "S")
xx = xx + 1
Next


End Sub

Hocam bazıları hata verdi. bazı sayıları toplamadı
 
Hocam, muygun Sorununuzu çözmüş..
Ben kodları denememiştim.
Lazımsa nerede hata verdiğini söylerseniz düzeltirim.
 
Geri
Üst