alttoplamı sıfırdan farklı olanları listeleme

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,596
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Merhaba,

Örnek sayfasında tek başına benzersiz bir sütun yok. Ama Satınalma belgesi ve kalem birlikte değerlendirildiğinde benzersiz bir alan oluşuyor. Sarı ile işaretli olan kısım onların alt toplamı. Benim istediğim alt toplamı sıfıra eşit olmayanları listelenmesi, cevap sayfasında bu koşulu sağlayan bir tane örnek var. Örnek sayfasında istediğim sonucu gösterdim. Tablo yaklaşık 100.000 satır ve klasik döngülerle yada formüllerle hesaplamasını bitiremiyor. ADO ile nasıl yapabilirim.
 

Ekli dosyalar

metehan8001

Yasaklı
Katılım
8 Nisan 2010
Mesajlar
125
Excel Vers. ve Dili
Office 2007 -2016 TR
Alternatif olsun;

Kod:
Sub ExcelDepo()
Set s1 = Sheets("örnek")
Set s2 = Sheets("cevap")
Set con = CreateObject("adodb.connection")
Set rs = CreateObject("adodb.recordset")
con.Open "provider=microsoft.ace.oledb.12.0;data source=" & _
    ThisWorkbook.FullName & ";extended properties=""excel 12.0;hdr=YES"""
sorgu = "SELECT distinct([Satınalma belgesi]), sum(Tutar) FROM [örnek$] group by [Satınalma belgesi] "
rs.Open sorgu, con, 1, 1
s1.Cells(1, 15).CopyFromRecordset rs
rs.Close
For ii = 1 To s1.Cells(Rows.Count, 15).End(xlUp).Row
sorgu = "select * from [örnek$A1:D65536] where [Satınalma belgesi] =  '" & (s1.Cells(ii, 15)) & "'   "
rs.Open sorgu, con, 1, 1
    If s1.Cells(ii, 16) <> "0" Then
s2.Cells(2, 1).CopyFromRecordset rs
End If
rs.Close
Next ii
con.Close
Set rs = Nothing
Set con = Nothing
s1.Range("o1").CurrentRegion.ClearContents
End Sub
 

Erdem Akdemir

Destek Ekibi
Destek Ekibi
Katılım
4 Mayıs 2007
Mesajlar
3,596
Excel Vers. ve Dili
2016 PRO TÜRKÇE-İNG. 64 BİT
Aşağıdaki sorgu ile çözümü buldum.

Kod:
sorgu = "select * from[örnek1$] where belge & kalem in (select distinct (belge & kalem ) from [örnek1$] where Tutar <> 0 and iş = '') "
 
Üst