Koşullu Büyüklüğe Göre Sıralama

[baydeniro]

Merhaba Arkadaşlar,
Stok durumu "var" olan ürünlerin C sütunundaki adet toplamları en büyük olan en küçüğe doğru
F sütununa : Ürün tanımlarının
G sütununa : Toplam hesaplanıp yazılması mümkün mü ?

 

[ÖmerFaruk]

Yardımcı sütun kullanarak çözülmüş hali ektedir.

 

[baydeniro]

Yardımcı sütun kullanarak çözülmüş hali ektedir.

Çok teşekkür ediyorum ÖmerFaruk üstadım, elinize sağlık, sağlıcakla kalın

 

[Korhan Ayhan]

ADO ile alternatif;

Tablonuzun altındaki açıklama yazdığınız birleştirilmiş hücreleri çözüp öyle deneyiniz.

Option Explicit

Sub Kosullu_Sirala()
    Dim Baglanti As Object, Kayit_Seti As Object, Sorgu As String
    
    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Kayit_Seti = CreateObject("AdoDb.Recordset")
    
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=No"""
    
    Sorgu = "Select F1,Sum(F3) From [Sayfa1$A2:C10] Where F2 = 'var' Group By F1 Order By Sum(F3) Desc"
    
    Kayit_Seti.Open Sorgu, Baglanti, 1, 1
    
    Range("F:G").Clear
    
    If Kayit_Seti.RecordCount > 0 Then
        Sheets("Sayfa1").Range("F1").CopyFromRecordset Kayit_Seti
    End If
    
    If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
    If Baglanti.State <> 0 Then Baglanti.Close

    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[baydeniro]

ADO ile alternatif;

Tablonuzun altındaki açıklama yazdığınız birleştirilmiş hücreleri çözüp öyle deneyiniz.

Option Explicit

Sub Kosullu_Sirala()
    Dim Baglanti As Object, Kayit_Seti As Object, Sorgu As String
   
    Set Baglanti = CreateObject("AdoDb.Connection")
    Set Kayit_Seti = CreateObject("AdoDb.Recordset")
   
    Baglanti.Open "Provider=Microsoft.Ace.OleDb.12.0;Data Source=" & _
    ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;Hdr=No"""
   
    Sorgu = "Select F1,Sum(F3) From [Sayfa1$A2:C10] Where F2 = 'var' Group By F1 Order By Sum(F3) Desc"
   
    Kayit_Seti.Open Sorgu, Baglanti, 1, 1
   
    Range("F:G").Clear
   
    If Kayit_Seti.RecordCount > 0 Then
        Sheets("Sayfa1").Range("F1").CopyFromRecordset Kayit_Seti
    End If
   
    If Kayit_Seti.State <> 0 Then Kayit_Seti.Close
    If Baglanti.State <> 0 Then Baglanti.Close

    Set Kayit_Seti = Nothing
    Set Baglanti = Nothing
   
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

Çok teşekkür ediyorum Korhan Ayhan üstadım, sağlıcakla kalın