Skip to main content

AccessTr.neT


Büroya Ve Rütbeye Göre Sıralama

Büroya Ve Rütbeye Göre Sıralama

#5
Kod:
Sub icmalDurum()

Dim Alan1 As Range
Dim Alan2 As Range

Set Sh1 = Worksheets("İcmal")
Set Sh2 = Worksheets("KONTROL")
Set Sh3 = Worksheets("VERİ")

Sh1.Activate
Sh1.Cells.Font.Bold = False
Sh1.Cells.Clear

    For i = 2 To Sh2.Range("B1").End(xlDown).Row
        Sh1.Cells(1, i) = Sh2.Range("B" & i)
    Next i

Sh1.Cells(1, i) = "Toplam"
Sh1.Range(Cells(1, 2), Cells(1, i)).HorizontalAlignment = xlCenter
Sh1.Range(Cells(1, 2), Cells(1, i)).VerticalAlignment = xlCenter
Sh2.Range("A2:A" & Sh2.Range("A1").End(xlDown).Row).Copy
Sh1.Range("A2").PasteSpecial xlPasteValues

Set Alan1 = Sh3.Range("E2:E" & Sh3.Range("A1").End(xlDown).Row)
Set Alan2 = Sh3.Range("F2:F" & Sh3.Range("A1").End(xlDown).Row)

    For i = 2 To Sh1.Cells(Rows.Count, "A").End(xlUp).Row
        For k = 2 To Sh1.Cells(1, Columns.Count).End(xlToLeft).Column
            Sh1.Cells(i, k) = WorksheetFunction.CountIfs(Alan2, Sh1.Range("A" & i).Value, Alan1, Sh1.Cells(1, k).Value)
        Next k
        Sh1.Cells(i, k - 1) = WorksheetFunction.Sum(Sh1.Range(Cells(i, 2), Sh1.Cells(i, k - 2)))
    Next i
 
Sh1.Cells(i, 1) = "Genel Toplam"

    For x = 2 To k - 1
        Sh1.Cells(i, x) = WorksheetFunction.Sum(Sh1.Range(Cells(2, x), Cells(i, x)))
    Next x
 
Rows(i).Font.Bold = True

    With Range(Cells(2, 2), Cells(i, k))
        .IndentLevel = 2
        .HorizontalAlignment = xlRight
    End With

Range(Cells(1, 1), Cells(1, k)).Font.Bold = True
Range(Cells(1, k), Cells(i, k)).Font.Bold = True
Range("A1").Activate
İcmalForm.Show

End Sub

ilgilenen herkese çok teşekkür ederim. Bu kodlarla sorun çözülmüştür.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da

Bu Konudaki Yorumlar
Büroya Ve Rütbeye Göre Sıralama - Yazar: hayalibey - 09/08/2020, 12:57
Re: Büroya Ve Rütbeye Göre Sıralama - Yazar: userx - 09/08/2020, 15:23
RE: Büroya Ve Rütbeye Göre Sıralama - Yazar: hayalibey - 09/08/2020, 15:31
Task