proje yardım

[oguzcanuz]

merhabalar,

üniversite öğrencisiyim ve bir konuda yardıma ihtiyacım var.
Projem bu. Birim Değer x Kullanılan Değer = Kullanılma Değeri,
Kümülatif Toplam'sa solundaki sütundan toplaya toplaya aşağıya iniyor. Örneğin(45000+22500) = 67500 alt satırına geliyor.
Kümülatif Yüzde ise en alttaki %100 olmak üzere sayıların o sayıya göre yüzdesi.
Yapamadığım kısım şu : Hocamız,Kullanılma Değerine göre sıralama yapılsın istiyor. Büyükten küçüğe. Fakat bunu isterken şunu da istiyor, Birim Değer ya da Kullanılan Değer'de bir değişiklik yaptığında Kullanılma Değeri değişiyor(çünkü birim değer x kullanılan ünite = kullanılma değeri) ve bu değişim de dinamik olarak sıralamada da değişsin istiyor. Bunun için makro bilmek gerekiyormuş fakat bunu ben yapamadım. Eğer yardımcı olabilecek varsa lütfen konuya yazsın, dosyayı yollarım. Çok teşekkürler

 

[kulomer46]

Değerli Arkadaşım Merhaba

Aşağıdaki Makro Kodları işinizi görür.

Selamlar...

Private Sub Worksheet_Calculate()

    Application.ScreenUpdating = False
    sayfaadi = ActiveSheet.Name
    If Len(Trim(Cells(1, 1))) < 1 Then Cells(1, 1) = "Grup 1"
    süt1 = Range("A1").End(xlToRight).Column
    sona = Cells(65500, 1).End(xlUp).Row
    sat1 = sona
  
    For i = 1 To sona
      
        For j = 1 To süt1
      
            If Cells(i, j) <> "" Then GoTo uç1
    
        Next
      
        sat1 = i
        GoTo uç2
uç1:
  
    Next
uç2:
  
            ActiveWorkbook.Worksheets(sayfaadi).Sort.SortFields.Clear
            ActiveWorkbook.Worksheets(sayfaadi).Sort.SortFields.Add2 Key:=Range("D2:D" & sat1) _
                , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            With ActiveWorkbook.Worksheets(sayfaadi).Sort
                .SetRange Range(Cells(1, 1), Cells(sat1, süt1))
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            Application.ScreenUpdating = True
  
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.ScreenUpdating = False
    sayfaadi = ActiveSheet.Name
    If Len(Trim(Cells(1, 1))) < 1 Then Cells(1, 1) = "Grup 1"
    süt1 = Range("A1").End(xlToRight).Column
    sona = Cells(65500, 1).End(xlUp).Row
    sat1 = sona
  
    For i = 1 To sona
      
        For j = 1 To süt1
      
            If Cells(i, j) <> "" Then GoTo uç1
    
        Next
      
        sat1 = i
        GoTo uç2
uç1:
  
    Next
uç2:
  
            ActiveWorkbook.Worksheets(sayfaadi).Sort.SortFields.Clear
            ActiveWorkbook.Worksheets(sayfaadi).Sort.SortFields.Add2 Key:=Range("D2:D" & sat1) _
                , SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            With ActiveWorkbook.Worksheets(sayfaadi).Sort
                .SetRange Range(Cells(1, 1), Cells(sat1, süt1))
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
            Application.ScreenUpdating = True
  
End Sub