satır ve sütun kesişimlerini sayma

[tahsinanarat]

ekli dosyamda icmal_makro sayfasının a sutununda İller, 1.satırda ise araba markaları bulunmaktadır. Liste sayfasından icmal_formül sayfasında ben formül kullanmak suretiyle icmal almayı başardım, ancak hesaplamanı uzun sürmesi hemde dosyayı şişirmemek adına bunu makro ile yapmak istiyorum. icmal_makro sayfasının B2:BF81 Aralığını hesaplayacak makrolarda yardımcı olabilcek arkadaşlarıma şimdiden çok teşekkür ederim. Saygılarımla.

 

[Ömer]

Merhaba,

Butona bağlayarak çalıştırınız.

Sub Icmal()
 
    Dim c As Range, ilkadres As Variant, St As Worksheet
    Dim say As Long, i As Long, j As Integer, son As Long
 
    Set St = Sheets("Liste")
    
    Application.ScreenUpdating = False
    Sheets("icmal_makro").Select
 
    son = Cells(Rows.Count, "A").End(xlUp).Row
    Range("B2", Cells(Rows.Count, Columns.Count)).ClearContents
 
    say = 1
    For i = 2 To son
        With St.Range("C:D")
            Set c = .Find(Cells(i, "A"), LookAt:=xlPart)
            If Not c Is Nothing Then
                ilkadres = c.Address
                Do
                    For j = 2 To Cells(1, Columns.Count).End(xlToLeft).Column
                        If St.Cells(c.Row, "E") Like "*" & Cells(1, j) & "*" Then
                            Cells(i, j) = Cells(i, j) + say
                            Cells(son + 2, j) = WorksheetFunction.Sum(Range(Cells(2, j), Cells(son, j)))
                        End If
                    Next j
                    Set c = .FindNext(c)
                Loop While Not c Is Nothing And c.Address <> ilkadres
            End If
        End With
    Next i
    
    Application.ScreenUpdating = True
 
End Sub

.

 

[tahsinanarat]

Ömer bey çok teşekkür ediyorum, mükemmel olmuş, elinize sağlık, sağolasınız.

 

[tahsinanarat]

Sn. Ömer hocam, son satıra alt toplam aldırmak istiyorum, koda nasıl bir ilave yapılabilir.

 

[Ömer]

#2 numaralı mesajı güncelledim. Tekrar denermisiniz.

.

 

[tahsinanarat]

Hocam harikasınız, çok çok teşekkür ederim. Emeğinize sağlık.

 

[Ömer]

Rica ederim, iyi çalışmalar.