- Katılım
- 6 Kasım 2005
- Mesajlar
- 300
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
Sub Formüller()
Dim wf As WorksheetFunction, i%, k%
Set wf = WorksheetFunction
For i = 8 To Range("C8").End(4).Row Step 5
Range("AK" & i) = wf.CountIf(Range("D" & i).Offset(2, 0).Resize(1, 30), "M") + wf.CountIf(Range("D" & i).Offset(2, 0).Resize(1, 30), "M") / 2
Range("AL" & i) = wf.CountIf(Range("D" & i).Offset(3, 0).Resize(1, 30), "Y") + wf.CountIf(Range("D" & i).Offset(3, 0).Resize(1, 30), "H")
Range("AM" & i) = wf.CountIf(Range("D" & i).Offset(0, 0).Resize(3, 30), "R")
Range("AI" & i) = wf.CountA(Range("D" & i).Offset(0, 0).Resize(3, 30)) - Range("AM" & i)
Range("AN" & i) = wf.Sum(Range("AI" & i).Resize(1, 5)) - Range("AM" & i)
Next i
For k = 0 To 5
Range("AI" & i).Offset(0, k) = wf.Sum(Range("AI8").Offset(0, k).Resize(i - 8, 1))
Next k
Set wf = Nothing: i = Empty: k = Empty
End Sub
Gönderdiğiniz örnek dosyada Toplam satırından önce ekleyeceğiniz tüm personel isimleri bulunan satırlar için kodlar görev yapacaktır.
For i = 8 To Range("C8").End(4).Row Step 5
Yukarıdaki kırmızı işaretli kısım bu işi yapıyor.
C8 hücrenizi seçin. Ctrl + Aşağı Ok basın
Seçilen yeni hücre son işlem yapacağınız satırdır.
Eğer farklı bir satır varsa hücre formatlarınızda örnek dosyanızdan farklı durum vardır.
Ömer Faruk bey...her bir satır için ayrı makrolar yaptığımda sorun çözülüyor...b8-b12-b16-b20-b24 hücrelerinde bulunan isimlerin karşılğını tek makro ,le çözmek istiyorum...
Teşekkürler...Step 5 yerine Step 4 olarak değiştirin.