İki sabit veriye karşılık gelen değeri başka bir sayfaya toplama

Katılım
4 Haziran 2011
Mesajlar
4
Excel Vers. ve Dili
2007
şablon oc sayfasında sarı renkli gösterilen ön büro ve telefon haberleşme giderlerine karşılık gelen 200 rakamı,ön büro sayfasında sarı renkle gösterilen c8 hücresine yazılmalı.Fakat şablon sayfasında ekleme ve çıkarmalar olduğu için formül her seferinde önbüro ve telefon haberleşme giderlerinin olduğu hücreyi bulmalı yardımınız için teşekkürler.
 

Ekli dosyalar

Ömer

Moderatör
Yönetici
Katılım
18 Ağustos 2007
Mesajlar
22,184
Excel Vers. ve Dili
Microsoft 365 Tr
Ofis 2016 Tr
Merhaba,

Module kopyalayıp çalıştırın.

Yalnız doğru sonuçlar alabilmeniz için, sayfa adları ile "şablon" sayfası A sütunundaki isimleri aynı olması gerekir.

Sayfa adı :ÖNBÜRO yerin ÖN BÜRO yazmanız gerekir.

Aynı şekilde sayfalarda yazdığınız gider türleri ile "şablon" sayfasında C sütunundaki gider türleri aynı olmalıdır.

Eğer uyuşmazlık olursa istediğiniz sonuçları alamazsınız.

Kod:
Sub Faliyet()
 
    Dim j As Integer, i As Long, c As Range, Adr As String
 
    Application.ScreenUpdating = False
    Sheets("ŞABLON OC").Select
    
    For j = 1 To Worksheets.Count
        With Sheets(j)
            If .Name <> "ŞABLON OC" Then
                .Range("C4:C" & Rows.Count).ClearContents
            End If
        End With
    Next j
            
    For j = 1 To Worksheets.Count
        With Sheets(j)
            If .Name <> "ŞABLON OC" Then
                For i = 4 To .Cells(Rows.Count, "B").End(xlUp).Row
                    Set c = [C:C].Find(.Cells(i, "B"), , xlValues, xlWhole)
                    If Not c Is Nothing Then
                        Adr = c.Address
                        Do
                            If Cells(c.Row, "A") = .Name Then
                                .Cells(i, "C") = Cells(c.Row, "E")
                            End If
                            Set c = [C:C].FindNext(c)
                        Loop While Not c Is Nothing And c.Address <> Adr
                    End If
                Next i
            End If
        End With
    Next j
    
End Sub
 
Üst