Şartlı toplam makrosu

[rain2003]

Merhaba girilen süreleri mazeretlere göre toplamak istiyorum fakat formul değil makro kullanmam gerekiyor.
Yardım cı olabilirseniz memnun olurum.

 

[YUSUF44]

aşağıdaki kodları bir modüle kopyalayıp deneyiniz:

Sub süre()
sonL = Cells(Rows.Count, "L").End(3).Row
sonA = Cells(Rows.Count, "A").End(3).Row

For i = 6 To sonA
    Cells(i, "C") = WorksheetFunction.CountIf(Range("L22:L" & sonL), Cells(i, "A"))
    Cells(i, "D") = WorksheetFunction.SumIf(Range("L22:L" & sonL), Cells(i, "A"), Range("K22:K" & sonL))
Next
End Sub

 

[rain2003]

Teşekkürler komutlar çalıştı.
Fakat K ve L sütünlarında ki veriler uzadıkça. C ve D sütunlarıda uzuyor. C ve D sütunlarındaki verileri 8 satırda sınırlamamk istiyorum mümkünse.

 

[Korhan Ayhan]

Emin misiniz?

Yusuf beyin önerdiği kod "A" sütunundaki en son dolu hücre kadar işlem yapıyor.

 

[rain2003]

Teşekkürler...
Açılan sayfa sayısı 30 olduğunda en son sayfayı silen makro Yapılabilirimi.
Ayrıca açılır menuden sayfa adları çıksa ve listelenen sayfalardan A916 verilerini sayfa 3 e aynı hücrelere çağıran makro yapılabilirmi. Biraz fazla soruyorum ama yapabildiklerimi yapıyorum yapamadıklarımı soruyrum.
Saygılar.

 

[Korhan Ayhan]

Dosyanızı eklerseniz üzerinde istediğiniz düzenlemeleri yapabiliriz.

Dosyanızda 30 sayfa olduğunda en son eklenen sayfayı otomatik silmek için aşağıdaki kodu kullanabilirsiniz.

Çalışmanızın "ThisWorkbook" bölümüne uygulayınız.

Private Sub Workbook_NewSheet(ByVal Sh As Object)
    Say = ThisWorkbook.Worksheets.Count
    If Say = 30 Then
        Application.DisplayAlerts = False
        ActiveSheet.Delete
        Application.DisplayAlerts = True
    End If
End Sub

 

[rain2003]

Aşağıda deneme sayfasını hazırladım. Düzenleme yaparsanız memnun olacağım.
Saygılarımla...

 

[Korhan Ayhan]

Combobox bulunan sayfanızın kod bölümüne aşağıdaki kodları uygulayıp deneyiniz.

Private Sub ComboBox1_Change()
    Sheets(ComboBox1.Text).Range("A9:D16").Copy Range("P13")
End Sub

Private Sub ComboBox1_DropButtonClick()
    Dim Sayfa As Worksheet, X As Integer, Sayfa_Listesi()
    For Each Sayfa In ThisWorkbook.Worksheets
        If Sayfa.Name <> "Sayfa1" Then
            X = X + 1
            ReDim Preserve Sayfa_Listesi(1 To X)
            Sayfa_Listesi(X) = Sayfa.Name
        End If
    Next
    ComboBox1.List = Sayfa_Listesi
End Sub

 

[YUSUF44]

Aşağıdaki kodları Sayfa1'in kod bölümüne yapıştırırsanız, Sayfa1 aktifleştirildiğinde sayfa isimleri Combobox'a gelir ve seçim yaptığınız sayfanın E6:F13 aralığındaki değerleri P13:Q20 aralığına getirir:

Combobox'a sayfa isimlerini getirme:

Private Sub Worksheet_Activate()
Dim i As Integer
For i = 1 To Sheets.Count
Sayfa1.ComboBox1.AddItem Sheets(i).Name
Next
End Sub

Seçilen sayfadan değerleri getirme:

Private Sub ComboBox1_Change()
If ComboBox1.Value <> "" Then
    [P13:Q21].ClearContents
    Sheets(ComboBox1.Value).[E6:F13].Copy: [P13].PasteSpecial Paste:=xlValues
End If
End Sub

 

[rain2003]

Korhan Ayhan hocam aşağıdaki kodlar en son eklenen sayfayı siliyor. En sağdaki sayfayı silmek için neyapmak lazım.


Private Sub Workbook_NewSheet(ByVal Sh As Object)
Say = ThisWorkbook.Worksheets.Count
If Say = 30 Then
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
End If
End Sub

 

[YUSUF44]

En sağdaki sayfayı silmek için

Sheets(sheets.count).delete

kullanılabilir.

 

[rain2003]

Sheets("sayfa1").Range("c6:d13").Copy
Sheets(Sheets(sayfa).[r3].Text).Range(Sheets(sayfa).[r5].Text).PasteSpecial paste:=xlPasteValues


Sevgili Hocalarım yukarıdaki kod ta takıldım formül ve biçimlendirme yapılmış bazı hücrelerdüzgün kopyalanmıyor. Neden olabilir.

 

[rain2003]

Sheets(ComboBox1.Text).Range("A7:J16").Copy Range("K17")

bu komut sadece değerleri kopyalacak şekilde nasıl düzenleniyor ?

 

[rain2003]

Sorunu buldum teşekkür ederim..