Stok özet toplamı ve sayfalara dağıtılması

[RALKAN]

Daha önce gönderdiğim bu konuda ki soruma ne yazıkki yardım alamadım, açıklamalarım açıklayıcı olmadığını düşünerek tekrar mesaj gönderiyorum.

Yapmak istediklerim ,
1.Topla Eğer veya Topla.çarpım fonksiyonları ile raporladığım satışlarımızı
data çoğaldıkça rapor alma süresinin uzamasından dolayı makro ile kısaltabilirmiyiz.
2. Koşul sayısı ikiden fazla olduğundan her açılışta tarama alanlarınının fazlalığı nedeniyle her alanın %100 hesaplama ihtiyacı doğuyor , bu hesaplama süresince excel bloke oluyor,bunu önlemek için de makro ile yapılabilinir mi diye
yardım bekliyorum.
3. Makro ile olmaz ise veya uzun bir çalışma gerektiriyor ise örnekteki fonksiyonların yukarda belirttiğim sorunları önlecek başka bir yolu varmıdır.

Çok daha zor örneklere cevap verildiğini gördüğümden her cevabıda dikkatli bir şekilde incelememe rağmen vba ile ilgili bilgim olmadığından cevap arıyorum
bu konuda yardımlarınızı bekliyorum.

Teşekkürler

 

[Recep İpek]

Merhaba,

Aşağıdaki makro kodları deneyiniz.

Burada bilgiler önce ÖZET sayfasına aktarılmakta, sonra ise buradan stok sayfalararına dağıtılmaktadır.

Dikkat etmeniz gereken tek nokta; yeni bir Stok Kalemi eklendiğinde bu isimde yeni bir sayfa açmak
ve makro kodlarındaki "'Stok Sayfa Adları" bölümüne bu sayfa ismini tanıtmaktadır.

Umarım işinize yarar...

Sub AktarTopla()
Dim a, i, n, k, b(), z, son, sat
Dim bul As Boolean
Set s1 = Sheets("Data")
Set s2 = Sheets("ÖZET")
'******************************************
a = s1.Range("a2:u" & s1.[a65536].End(3).Row).Value
ReDim b(1 To UBound(a, 1), 1 To 29)
With CreateObject("Scripting.Dictionary")
    .CompareMode = vbTextCompare
    For i = 1 To UBound(a, 1)
           If Not IsEmpty(a(i, 1)) Then
                z = a(i, 1) & ":" & a(i, 6)
                If Not .exists(z) Then
                    n = n + 1
                    b(n, 1) = n
                    b(n, 2) = a(i, 1)
                    b(n, 3) = a(i, 6)
                    b(n, 4) = a(i, 7)
                    .Add z, n
                End If
                    b(.Item(z), 4 + a(i, 5)) = b(.Item(z), 4 + a(i, 5)) + a(i, 8)
                    b(.Item(z), 17 + a(i, 5)) = b(.Item(z), 17 + a(i, 5)) + a(i, 15)
            End If
    Next
End With
'*******************************************
son = s2.[a65536].End(3).Row
s2.Range(s2.Cells(3, "a"), s2.Cells(son, "ac")).ClearContents
s2.[a3].Resize(n, 29).Value = b
'*******************************************
stoksayfa = Array("[COLOR=blue]MOB-AT01[/COLOR]", "[COLOR=blue]MOB-AT17[/COLOR]", "[COLOR=blue]MOB-KR01[/COLOR]")   [COLOR=red]'Stok Sayfa Adları[/COLOR]
For i = 0 To UBound(stoksayfa)
stoksaysil = stoksayfa(i)
    For Each sadi In Worksheets
        If UCase(sadi.Name) = UCase(stoksaysil) Then
             Set s3 = Sheets(sadi.Name)
             sat = s3.[a65536].End(3).Row
             s3.Range(s3.Cells(3, "a"), s3.Cells(sat, "ac")).ClearContents
        End If
    Set s3 = Nothing
    Next
Next i
'*******************************************
For i = 3 To s2.[a65536].End(3).Row
stok = s2.Cells(i, "b").Value
bul = False
    For Each sadi In Worksheets
        If UCase(sadi.Name) = "Data" Or UCase(sadi.Name) = "ÖZET" Then GoTo 10
        If UCase(sadi.Name) = UCase(stok) Then
             Set s4 = Sheets(sadi.Name)
             sat = s4.[a65536].End(3).Row + 1
             s4.Cells(sat, "a").Value = sat - 2
             s4.Range(s4.Cells(sat, "b"), s4.Cells(sat, "ac")).Value = s2.Range(s2.Cells(i, "b"), s2.Cells(i, "ac")).Value
             bul = True
        End If
        Set s4 = Nothing
10     Next
If bul = False Then MsgBox stok & " Sayfası Bulunamadı!!", vbInformation, "Bilgi"
Next i
'*******************************************
MsgBox "Bitti"
s2.Select
[a1].Select
Set s1 = Nothing
Set s2 = Nothing
End Sub

 

[RALKAN]

Koşullu toplam vba

Sayın Ripek ,

Siz ve diğer uzman arkadaşlardan cevap geleceğini tahmin ediyordum uzun süredir izlediğim forumda ki yardımlarınızdan dolayı.Hemen diğer stok kalemlerinde çalışıp çalışmadığını kontrol edeceğim, sonucu size bildireceğim.

Zamanınızı ayırıp benim büyük bir sorunuma çözüm buldunuz çok teşekkür ederim.

Ralkan