Vba İle Carİ Rapor Alma

[a_self_lion]

selam arkadaşlar

Öncelikle dosyamı ekte gönderiyorum gerekli açıklama orda da var.

BURDA İSTEMİŞ OLUDĞUM RAPOR_2 SAYFASINDAKİ GİBİ OLACAK

AÇIKLAYACAK OLURSAM

C SUTUNDA Kİ KODLARI AYNI OLANLARIN BİRTANESİ VE YANINDAKİ D SUTUNDAKİ İSİMİ RAPOR_2 A VE B SUTUNA YAZILACAK SUTUNU YAZILACAK

SONRA K SUTUNDA EĞER DEĞERİ B OLANLARIN J SUTUNDAKİ TOPLAM TUTARLARI TOPLANIP VERİ SAYFASINDA NE KADAR VARSA TOPLAMIN TUTARI DA RAPOR_2 SAYFASINDAKİ C SUTUNA YAZILACAK SIRA İLE BU İŞLEMLER BÜTÜN KODLARA UYGULANACAK.

YANİ CARİ LERİN TOPLAMLARINI ALMIŞ OLACAĞIZ.

BİLDİĞİM KADARIYLA BU İŞLEM SET TANIMLANIYOR O ŞEKİLDE YAPILIYOR AMA BU KONUYU BİR TÜRLÜ KAVRAYAMADIM İLGİLENEN ARKADAŞLARA ŞİMDİDEN TEŞEKKÜR EDERİM.

 

[a_self_lion]

Sayın ripek burda buna benzer bir sorunum vardı onu çözmüştü bu da ona benziyor ben o kadar inceleme me rağmen olayı kavrayamadığım için çözüme ulaşmıyorum.
Yardım ederseniz sevinirim.

http://www.excel.web.tr/showthread.php?t=38950

 

[N.Ziya Hiçdurmaz]

Yanıt

Sub TOPLAMAKTAR()
Set S1 = Sheets("veri")
Set S2 = Sheets("rapor_2")
S2.[A2:C1000].Clear
For SUT = 2 To S1.[C65536].End(3).Row
If WorksheetFunction.CountIf(S1.Range("C1:C" & SUT), S1.Range("C" & SUT)) = 1 Then
S = S2.[A65536].End(3).Row
S2.Range("A" & S + 1) = S1.Range("C" & SUT).Value
End If
Next
For SUT = 2 To S1.[D65536].End(3).Row
If WorksheetFunction.CountIf(S1.Range("D1:D" & SUT), S1.Range("D" & SUT)) = 1 Then
S = S2.[B65536].End(3).Row
S2.Range("B" & S + 1) = S1.Range("D" & SUT).Value
End If
Next
For SUT1 = 2 To S1.[D65536].End(3).Row
For SUT2 = 2 To S2.[B65536].End(3).Row
If S2.Range("B" & SUT2) = S1.Range("D" & SUT1) And S1.Range("K" & SUT1).Value = "B" Then
S2.Range("C" & SUT2) = S2.Range("C" & SUT2) + S1.Range("H" & SUT1)
End If
Next
Next
End Sub

 

[a_self_lion]

Sayın V.Basic For Applications vbmenu_register("postmenu_217097", true); Çok güzel olmuş elinize sağlık. Bizlerinde Bu konularda daha fazla bilgilenebilmesi için kodlarınızı açıklama yazarsanız ve kısa birde açıklama yaparsanız tabi zamanınız olursa bir dahaki bu tür konularda sizleri rahatsız etmeyiz ve diğer uygulamalarımızda bizde anlayarak yapabiliriz. Tekrar tekrar teşekkür ediyorum.

 

[a_self_lion]

Gerçek projede sorun çıktı

Sayın V.Basic For Applications Kodlarınız güzel çalıştı ama bazı aksaklılar oldu. Toplamlarda sorun oldu tüm projeme uygulayınca ve borcu olmayanlar gözüktü.

Bütün projemi ekliyorum gerekli açıklamalarımı yaptım. proje içinde birde ekran görüntüsü var sorunlarla ilgili. Bir bakarsanız sevinirim.
Teşekkürler.

 

[N.Ziya Hiçdurmaz]

Yanıt

Bir deneyiniz.

Sub TOPLAMAKTAR()
On Error Resume Next
Set S1 = Sheets("veri")
Set S2 = Sheets("rapor_2")
S2.[A2:C1000].Clear
For SUT = 2 To S1.[C65536].End(3).Row
If WorksheetFunction.CountIf(S1.Range("C1:C" & SUT), S1.Range("C" & SUT)) = 1 Then
S = S2.[A65536].End(3).Row
S2.Range("A" & S + 1) = S1.Range("C" & SUT).Value
S2.Range("B" & S + 1) = S1.Range("D" & SUT).Value
End If
Next
For SUT1 = 2 To S1.[D65536].End(3).Row
For SUT2 = 2 To S2.[B65536].End(3).Row
If S2.Range("B" & SUT2) = S1.Range("D" & SUT1) And S1.Range("K" & SUT1).Value = "B" Then
S2.Range("C" & SUT2) = S2.Range("C" & SUT2) + S1.Range("H" & SUT1)
End If
Next
Next
End Sub