Çözüldü Oran Hesaplama Hk.

[Erdogan34]

Merhabalar,
Bir konuda desteğinizi rica ediyorum. Öncelikle tablomda maksimum satır sayısı değişkenlik göstermektedir. İlk 8 kolon makro ile oluşmaktadır. Örnekte görünen son iki kolonu da kodun altına ekleyerek hazırlamaya çalışmaktayım. Kolon açıklamalarını örnek dosyaya yazdım.
Desteğinizi rica ediyorum.
Saygılarımla.

 

[İbrahim Görgülü]

Sayın Erdogan34 örnek dosyanızda makrolar yok macrolu dosyanızı ekler iseniz kodu içine ekleyelim.

 

[Erdogan34]

Sayın Erdogan34 örnek dosyanızda makrolar yok macrolu dosyanızı ekler iseniz kodu içine ekleyelim.

Hocam asıl dosyanın makrosunu ekledim. Aslında daha önce yaptıklarınızı referans alarak aşağıdaki kodla veri getirebildim ancak döngü oluşturamadığım için satır sayılarının çok daha aşağısına devam etti.

Cells(Z, 26).Value = Cells(Z, 19).Value / Cells(Cells(Rows.Count, 19).End(3).Row, 19)
Cells(Z, 27).Value = Cells(Z, 22).Value / Cells(Cells(Rows.Count, 22).End(3).Row, 22)

 

[Erdogan34]

Hocam asıl dosyanın makrosunu ekledim. Aslında daha önce yaptıklarınızı referans alarak aşağıdaki kodla veri getirebildim ancak döngü oluşturamadığım için satır sayılarının çok daha aşağısına devam etti.

Cells(Z, 26).Value = Cells(Z, 19).Value / Cells(Cells(Rows.Count, 19).End(3).Row, 19)
Cells(Z, 27).Value = Cells(Z, 22).Value / Cells(Cells(Rows.Count, 22).End(3).Row, 22)

İbrahim Hocam,
Aşağıdaki şekilde döngü kurarak sonuç aldım. Ekstra vaktinizi almak istemem. Zira en az benim kadar yardım edebileceğiniz birçok arkadaşımız var. Tüm destekleriniz için çok ama çok teşekkür ederim.

HTML:

İçeriği görebilmek için Giriş yap ya da Üye ol.

Saygımlarımla.

 

[İbrahim Görgülü]

İbrahim Hocam,
Aşağıdaki şekilde döngü kurarak sonuç aldım. Ekstra vaktinizi almak istemem. Zira en az benim kadar yardım edebileceğiniz birçok arkadaşımız var. Tüm destekleriniz için çok ama çok teşekkür ederim.

Cells(1, "m").Select
a = Cells(Rows.Count, "r").End(3).Row
If a <= 2 Then
a = 2
Range("r2:aa" & a).ClearContents
Else
Range("r2:aa" & a).ClearContents
End If
s = Cells(Rows.Count, "k").End(3).Row
If s >= 8 Then
Z = 2
For x = 8 To s
If Application.WorksheetFunction.CountIf(Range("r1:r" & Cells(Rows.Count, 18).End(3).Row), Cells(x, 11)) < 1 Then
Cells(Cells(Rows.Count, 18).End(3).Row + 1, 18) = Cells(x, 11)
Cells(Cells(Rows.Count, 19).End(3).Row + 1, 19) = Application.WorksheetFunction.SumIf(Range("k7:k" & s), Cells(x, 11), Range("o7" & s))
Cells(Cells(Rows.Count, 20).End(3).Row + 1, 20) = Application.WorksheetFunction.SumIf(Range("k7:k" & s), Cells(x, 11), Range("L7:l" & s))
Cells(Cells(Rows.Count, 21).End(3).Row + 1, 21) = Application.WorksheetFunction.SumIf(Range("k7:k" & s), Cells(x, 11), Range("m7:m" & s))
Cells(Cells(Rows.Count, 22).End(3).Row + 1, 22) = Application.WorksheetFunction.SumIf(Range("k7:k" & s), Cells(x, 11), Range("n7:n" & s))
Cells(Z, 23).Value = Cells(Z, 20).Value / Cells(Z, 19).Value
Cells(Z, 24).Value = Cells(Z, 21).Value / Cells(Z, 19).Value
Cells(Z, 25).Value = Cells(Z, 22).Value / Cells(Z, 19).Value
Z = Z + 1
End If
Next
Cells(Cells(Rows.Count, 18).End(3).Row + 1, 18) = "Genel Toplam"
Cells(Cells(Rows.Count, 19).End(3).Row + 1, 19) = Application.WorksheetFunction.Sum(Range("s2:s" & Cells(Rows.Count, 19).End(3).Row))
Cells(Cells(Rows.Count, 20).End(3).Row + 1, 20) = Application.WorksheetFunction.Sum(Range("t2:t" & Cells(Rows.Count, 20).End(3).Row))
Cells(Cells(Rows.Count, 21).End(3).Row + 1, 21) = Application.WorksheetFunction.Sum(Range("u2:u" & Cells(Rows.Count, 21).End(3).Row))
Cells(Cells(Rows.Count, 22).End(3).Row + 1, 22) = Application.WorksheetFunction.Sum(Range("v2:v" & Cells(Rows.Count, 22).End(3).Row))
Cells(Z, 23).Value = Cells(Z, 20).Value / Cells(Z, 19).Value
Cells(Z, 24).Value = Cells(Z, 21).Value / Cells(Z, 19).Value
Cells(Z, 25).Value = Cells(Z, 22).Value / Cells(Z, 19).Value
Z = Z + 1
End If
GoTo 1
1:
Dim Say As Long
Dim Bak As Long
Dim ToplamB As Double
Dim ToplamE As Double
Say = Cells(Rows.Count, "R").End(xlUp).Row
ToplamB = Cells(Cells(Rows.Count, 19).End(3).Row, 19)
ToplamE = Cells(Cells(Rows.Count, 22).End(3).Row, 22)

For Bak = 2 To Say
Cells(Bak, "Z") = Cells(Bak, "S") / ToplamB
Cells(Bak, "AA") = Cells(Bak, "V") / ToplamE
Next
Cells(Say, "Z") = 1
Cells(Say, "AA") = 1

Saygımlarımla.

ilerlemeye devam tebrikler.