2 sayfadakisayımlarıteksayfaya toplama

[raaroka]

Arkadaşlar 2 sayfadaki sayım miktarlarını aynı sayfaya alıp 3. sonuçsayfasına aktarmak istiyorum.
Fakat sıkıntım şu 1.Sayımda aynı malzeme kodundan 10 tane olabilir.Bunlarıda toplayıp 3. sayfaya rakkamları aktarmalı.

2. sayım sayfasındanda verileri aktarmalı.

2 sayımdaki malzeme kodlarına göre 3. sayfaya sayım farklarını bulmak istiyorum yani.sayfayı ekliyorum umarım anlayabilmişimdir.

 

[Emir Hüseyin Çoban]

. . .

Sub kod()
    Application.ScreenUpdating = False
    Dim S1 As Worksheet
    Dim S2 As Worksheet
    Dim SO As Worksheet
    Set S1 = Sheets("Sayım1")
    Set S2 = Sheets("Sayım2")
    Set SO = Sheets("Sonuç")
    
    SO.Range("A2:D65536").ClearContents
    Sat = 2
    S1s = S1.[C65536].End(3).Row
    For i = 2 To S1s
        If S1.Cells(i, "C") <> "" And _
            WorksheetFunction.CountIf(SO.Range("A:A"), S1.Cells(i, "C")) = 0 Then
            SO.Cells(Sat, "A") = S1.Cells(i, "C")
            SO.Cells(Sat, "B") = _
            WorksheetFunction.SumIf(S1.Range("C2:C65536"), S1.Cells(i, "C"), S1.Range("D2:D65536"))
            SO.Cells(Sat, "C") = _
            WorksheetFunction.SumIf(S2.Range("B2:B65536"), S1.Cells(i, "C"), S2.Range("D2:D65536"))
            SO.Cells(Sat, "D") = SO.Cells(Sat, "B") - SO.Cells(Sat, "C")
            Sat = Sat + 1
        End If
    Next i
    Application.ScreenUpdating = True
    MsgBox " B i t t i "
End Sub

. . .

 

[raaroka]

. . .

Sub kod()
    Application.ScreenUpdating = False
    Dim S1 As Worksheet
    Dim S2 As Worksheet
    Dim SO As Worksheet
    Set S1 = Sheets("Sayım1")
    Set S2 = Sheets("Sayım2")
    Set SO = Sheets("Sonuç")
    
    SO.Range("A2:D65536").ClearContents
    Sat = 2
    S1s = S1.[C65536].End(3).Row
    For i = 2 To S1s
        If S1.Cells(i, "C") <> "" And _
            WorksheetFunction.CountIf(SO.Range("A:A"), S1.Cells(i, "C")) = 0 Then
            SO.Cells(Sat, "A") = S1.Cells(i, "C")
            SO.Cells(Sat, "B") = _
            WorksheetFunction.SumIf(S1.Range("C2:C65536"), S1.Cells(i, "C"), S1.Range("D2:D65536"))
            SO.Cells(Sat, "C") = _
            WorksheetFunction.SumIf(S2.Range("B2:B65536"), S1.Cells(i, "C"), S2.Range("D2:D65536"))
            SO.Cells(Sat, "D") = SO.Cells(Sat, "B") - SO.Cells(Sat, "C")
            Sat = Sat + 1
        End If
    Next i
    Application.ScreenUpdating = True
    MsgBox " B i t t i "
End Sub

. . .

Üstadım cevap için çok teşekkürler.Bu yazdığın kodları uyguladım çalıştı çok teşekkür ederim. Ama bir sonraki seferde kendim yapabilmem için makro yerine formüllerle çözebilmek istiyorum.Böyle armut piş ağzıma düş oldu. Kesinlikle bütün iş yükündenkurtardı ama dediğim gibi bir sonrakiseferdefarklı bir tablodada kendim yapabilmek isterim ondan dolayı söylüyorum umarım yanlış anlamazsın.

 

[Emir Hüseyin Çoban]

. . .

Excelin yerleşik işlevleri ve formülleri ile çözüm için

Sayım1 sayfasında
C2:C10 aralığı seçip kopyalayın >
Sonuç sayfasında A2 hücresine yapıştırın.
A2:A10 aralığı seçiliyken, üst menülerden
Veri > Yinelenenleri Kaldır > Geçerli seçimle devam et
Bu şekilde mükerrer olan kodları teke düşürüyoruz.

Sonuç sayfasında
Sayım1 rakamlarının toplamlarını almak için
B2 hücresine formül: =ETOPLA(Sayım1!$C$2:$D$100;A2;Sayım1!$D$2:$D$100)
aşağıya doğru çoğaltın.

Sayım2 rakamlarının toplamlarını almak için
C2 hücresine formül: =ETOPLA(Sayım2!$B$2:$D$100;A2;Sayım2!$D$2:$D$100)
aşağıya doğru çoğaltın.

D2 hücresinde Farkı almak için formül: =B2-C2

Yinelenenleri kaldırma ve ETOPLA işlevlerini biraz araştırarak, hızlıca kendiniz yapabilecek hale gelirsiniz.

. . .