• DİKKAT

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

Çokludüşeyara ve alttoplam alarak veri taşıma

B

batuhantmotyy

Katılım
8 Mart 2008
Mesajlar
12
Excel Vers. ve Dili
excel 2007
Merhabalar,

Ek'te örnek hazırladığımız tabloda depo stoklarını ve sistemin çekmek için istediği hareket planını alt toplam ile konselide ederek ana form sayfasına aldırmak mümkün olur mu? yardımlarınız için teşekkürler,

Saygılarımla
 

Ekli dosyalar

Merhabalar,

Formu inceledim fakat, bu ve benzeri örnek bulamadım, (2 li ve 3 lü düşeyara ve alttoplam alacak)
Bi el atabilir misiniz? lütfen

Teşekkürler
 
Sn.Akyürek merhaba,

Öncelikle yardımınız için teşekkür ederim.
Fonksiyon/ formül ile bu büyüklükte tablonun oluşturulması kullanışı açısından çok zaman gerektirecek gibi, süreci kısaltmak ve kullanışını artırmak için macro ile çözüme ulaşabileceğimizi öngörmekteyiz.

Formda bulunan düşeyara makrosu ile bir noktaya getirebiliyoruz, ancak içeriğe çoklu kontrol ve altoplam girince işin içinde çıkmak bizim için olanaksız olmaktadır. Bu neden ile macro konusunda yardım beklemekteyiz. Tekrar teşekkür ederim.

saygılarımla
 
Merhaba,

İlk buton için aşağıdaki makroyu kullanabilirsiniz.

Ben 1000 satır veri için denedim. Yaklaşık 2-3 dakika içinde sonuçları döndürüyor. İşlemciniz iyi ise sizde süre dahada kısalabilir.

Kod: 
Sub DEPO_STOK_DURUMU()
    Dim X As Long, Y As Integer, Zaman As Date
    Dim S1 As Worksheet, S2 As Worksheet, Tarih1 As Date, Tarih2 As Date
 
    Zaman = Time
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    Set S1 = Sheets("ana form sayfası")
    Set S2 = Sheets("depo stokları")
 
    S2.Range("A1").AutoFilter
 
    For X = 12 To S1.Cells(Rows.Count, 1).End(3).Row
        For Y = 3 To 16
            S2.Range("A1").AutoFilter Field:=4, Criteria1:=S1.Cells(11, Y)
            S2.Range("A1").AutoFilter Field:=5, Criteria1:=S1.Cells(X, 1)
            S1.Cells(X, Y) = WorksheetFunction.Subtotal(9, S2.Range("I:I"))
        Next
    Next
 
    S2.Range("A1").AutoFilter
 
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
 
    MsgBox "Stok bilgileri aktarılmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format(Time - Zaman, "hh:mm:ss"), vbInformation
End Sub
 
Merhaba Korhan bey,

Evde çocuğun bilgisayarı ile çalıştırdığımda haklısınız süreç 3-4 dk. uzamakta, fakat; işyerindeki pc'lerde kesinlik problem olmayacak bir çalışma... :)

2. buton için 3'lü düşeyarama&alttoplam ve bugün() öncesi true/false aktarımı konusunda da yardımcı olmanız mümkün mü?

Yardımlarınız için sonsuz teşekkürlerimi sunarım.

Saygılarımla
 
Merhaba,

Aşağıdaki kodu deneyiniz.

Kod: 
Sub DEPO_HAREKET_PLANI()
    Dim X As Long, Y As Integer, Zaman As Date
    Dim S1 As Worksheet, S2 As Worksheet, Tarih1 As Date, Tarih2 As Date
 
    Zaman = Time
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    Set S1 = Sheets("ana form sayfası")
    Set S2 = Sheets("depo hareket planı")
    
    S2.Range("A2").AutoFilter
 
    For X = 12 To S1.Cells(Rows.Count, 1).End(3).Row
        Tarih1 = Format(CLng(S1.Cells(11, 26)) + TimeValue("00:00:00"), "dd.mm.yyyy hh:mm:ss")
        S2.Range("A2").AutoFilter Field:=5, Criteria1:=S1.Cells(X, 1)
        S2.Range("A2").AutoFilter Field:=9, Criteria1:="<" & CLng(CDate(Tarih1))
        S2.Range("A2").AutoFilter Field:=10, Criteria1:=S1.Cells(10, 26)
        S2.Range("A2").AutoFilter Field:=5, Criteria1:=S1.Cells(X, 1)
        S1.Cells(X, 24) = WorksheetFunction.Subtotal(9, S2.Range("G:G"))
        S2.Range("A2").AutoFilter Field:=10, Criteria1:=S1.Cells(10, 27)
        S1.Cells(X, 25) = WorksheetFunction.Subtotal(9, S2.Range("G:G"))
        
        For Y = 26 To 95 Step 2
            Tarih1 = Format(CLng(S1.Cells(11, Y)) + TimeValue("00:00:00"), "dd.mm.yyyy hh:mm:ss")
            Tarih2 = Format(CLng(S1.Cells(11, Y)) + TimeValue("23:59:59"), "dd.mm.yyyy hh:mm:ss")
            
            S2.Range("A2").AutoFilter Field:=5, Criteria1:=S1.Cells(X, 1)
            S2.Range("A2").AutoFilter Field:=9, Criteria1:=">=" & CLng(CDate(Tarih1)), _
            Operator:=xlAnd, Criteria2:="<=" & CLng(CDate(Tarih2))
            S2.Range("A2").AutoFilter Field:=10, Criteria1:=S1.Cells(10, Y)
            S2.Range("A2").AutoFilter Field:=5, Criteria1:=S1.Cells(X, 1)
            S1.Cells(X, Y) = WorksheetFunction.Subtotal(9, S2.Range("G:G"))
            S2.Range("A2").AutoFilter Field:=10, Criteria1:=S1.Cells(10, Y + 1)
            S1.Cells(X, Y + 1) = WorksheetFunction.Subtotal(9, S2.Range("G:G"))
        Next
    Next
 
    S2.Range("A2").AutoFilter
 
    Application.Calculation = xlCalculationAutomatic
    Application.ScreenUpdating = True
 
    MsgBox "Stok bilgileri aktarılmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format(Time - Zaman, "hh:mm:ss"), vbInformation
End Sub
 
Korhan bey günaydın,

Tekrar rahatsız ediyorum, kusuruma bakmayın,

Ek'te hesaplamayı hızlandırmak için malzeme ve veri sayısını düşürdüm, fakat 2. işlemi yapacak macro tüm veriyi "0" adetli taşıdı.
Müsait iseniz tekrar inceleyebilir misiniz?

Saygılarımla
 

Ekli dosyalar

Merhaba,

Önceki mesajlarımdaki iki koduda revize ettim. Tekrar deneyiniz.

Birde hızlandırmak için başka bir yol deniyorum. Olumlu sonuç alırsam eklerim.
 
Merhaba,

Aşağıdaki kodda ÇOKETOPLA fonksiyonu kullanılmıştır. Bu şekilde işlem daha hızlı sonuçlanmaktadır. Bu fonksiyon 2007 ve sonraki versiyonlarda çalışmaktadır. Önceki sürümlerde hata verir.

Kod: 
Sub HIZLI_DEPO_STOK_DURUMU()
    Dim Zaman, Satir, Son, Formul
 
    Zaman = Time
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationAutomatic
 
    Satir = Cells(Rows.Count, 1).End(3).Row
    Son = Sheets("depo stokları").Cells(Rows.Count, 1).End(3).Row
 
    Range("C12:P" & Rows.Count).ClearContents
    Formul = "=SUMIFS('depo stokları'!$I$2:$I$1048576,'depo stokları'!$D$2:$D$1048576,C$11,'depo stokları'!$E$2:$E$1048576,$A12)"
    Formul = Replace(Formul, 1048576, Son)
 
    With Range("C12:P" & Satir)
        .Formula = Formul
        .Value = .Value
    End With
 
    Application.ScreenUpdating = True
 
    MsgBox "Stok bilgileri aktarılmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format(Time - Zaman, "hh:mm:ss"), vbInformation
End Sub

Kod: 
Sub HIZLI_DEPO_HAREKET_PLANI()
    Dim Zaman, Satir, Son, Formul
 
    Zaman = Time
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationAutomatic
 
    Satir = Cells(Rows.Count, 1).End(3).Row
    Son = Sheets("depo stokları").Cells(Rows.Count, 1).End(3).Row
 
    Range("X12:CQ" & Rows.Count).ClearContents
    Formul = "=SUMIFS('depo hareket planı'!$G$3:$G$1048576,'depo hareket planı'!$E$3:$E$1048576,$A12,'depo hareket planı'!$I$3:$I$1048576,""<""&TODAY(),'depo hareket planı'!$J$3:$J$1048576,X$10)"
    Formul = Replace(Formul, 1048576, Son)
 
    With Range("X12:Y" & Satir)
        .Formula = Formul
        .Value = .Value
    End With
 
    Formul = "=SUMIFS('depo hareket planı'!$G$3:$G$1048576,'depo hareket planı'!$E$3:$E$1048576,$A12,'depo hareket planı'!$I$3:$I$1048576,"">=""&OFFSET(Z$11,0,IF(MOD(COLUMN(),2)=0,0,-1))+TIME(0,0,0),'depo hareket planı'!$I$3:$I$1048576,""<=""&OFFSET(Z$11,0,IF(MOD(COLUMN(),2)=0,0,-1))+TIME(23,59,59),'depo hareket planı'!$J$3:$J$1048576,Z$10)"
    Formul = Replace(Formul, 1048576, Son)
 
    With Range("Z12:CQ" & Satir)
        .Formula = Formul
        .Value = .Value
    End With
    Application.ScreenUpdating = True
 
    MsgBox "Stok bilgileri aktarılmıştır." & Chr(10) & _
           "İşlem süresi ; " & Format(Time - Zaman, "hh:mm:ss"), vbInformation
End Sub
 
Korhan bey,

Çok teşekkür ederim, yoldayım işyerine varır varmaz çalıştırıp neticeyi size bildireceğim.

Saygılarımla
 
Merhaba cyberwolf1980,

Yardımların için teşekkür ederim. Ancak; kullanacağımız formun boyutu çok büyük olduğu için fonksiyon ile çözüme kavuşmamız çok zor, bu neden ile makro konusunda destek aradık. bilgilerinize

saygılarımla
 
Korhan bey merhaba

Tek kelime ile harika olmuş. ellerinize sağlık.
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst