Değişken aralıktaki değerleri koşula göre saymak

[cerit]

Merhaba,
Yapmak istediğimi dosya içerisinde paylaştım.
Selamlar.

 

[cerit]

Merhaba,
Dosyayı yeniledim.Yeni duruma göre;
Eğersay ile aralıkta 4'ten büyük değerleri saydırıyorum.Fakat yapmak istediğim ayın son haftasında "HT" veya "boşluk" tan sonra gelen 4'ten büyük değerleri saydırmak.(gelecek ay ile birleştirildiğinde "aralıksız" altı gün kuralını uygulamak için)
Selamlar.

 

[mersilen]

Merhaba
Kodları bir dener misiniz*

Sub GA()
Range("AO6:AO18") = none
For i = 6 To 18: say = 0

  If Cells(i, "AH") = "HT" Or WorksheetFunction.CountIf(Range("AC" & i & ":AG" & i), "") = 5 Then
  Cells(i, "AO") = 0
  Else:
  If WorksheetFunction.CountIf(Range("AC" & i & ":AG" & i), "") = 0 Or WorksheetFunction.CountIf(Range("AC" & i & ":AG" & i), "HT") = 0 Then
  Cells(i, "AO") = WorksheetFunction.CountIf(Range("AC" & i & ":AG" & i), ">4")
  End If
  For Each hucre In Range("AC" & i & ":AG" & i)
      If hucre.Value = "HT" Or hucre.Value = "" Then
      say = WorksheetFunction.CountIf(Range(Cells(i, hucre.Column), Cells(i, "AG")), ">4")

      Cells(i, "AO") = say
      End If
  Next
  
  End If

 

[cerit]

Hocam merhaba,
Elinize sağlık,tam yapmak istediğim gibi olmuş,
http://www.excel.web.tr/f48/ki-dosya-verisini-saydyrarak-yazdyrmak-t143128.html
linkte olan dosyanın kırmızı sayfaları dışındaki sayfalarda çalışacak şekilde düzenleyebilir miyiz.
Selamlar

 

[cerit]

Hocam merhaba,
sizin yazdığınız kod'a aşağıdaki gibi ekleme yaparak işimi kısmen çözdüm.İşlemi seçtiğim sayfalarda yapıyor,fakat işlem sonunda en son sayfayı açıyor.Tekrar teşekkür ederim.
Selamlar.

Sub SONRAKI_AYADEVİR()
 Application.ScreenUpdating = False
    Dim aktif As String
    aktif = ActiveSheet.Name
    
    For x = 1 To Sheets.Count
        If Sheets(x).Name <> "BORDRO" And _
        Sheets(x).Name <> "VERİ" And _
        Sheets(x).Name <> "FAT" And _
        Sheets(x).Name <> "FAT1" And _
        Sheets(x).Name <> " BÖL" Then
        
        Sheets(x).Select
        Range("AP5:AP104") = none
        For i = 5 To 104: say = ""

    If Cells(i, "AH") = "HT" Or WorksheetFunction.CountIf(Range("AC" & i & ":AG" & i), "") = 5 Then
  Cells(i, "AP") = ""
     Else:
    If WorksheetFunction.CountIf(Range("AC" & i & ":AG" & i), "") = 0 Or WorksheetFunction.CountIf(Range("AC" & i & ":AG" & i), "HT") = 0 Then
  Cells(i, "AP") = WorksheetFunction.CountIf(Range("AC" & i & ":AG" & i), ">4")
    End If
    For Each hucre In Range("AC" & i & ":AG" & i)
      If hucre.Value = "HT" Or hucre.Value = "" Then
      say = WorksheetFunction.CountIf(Range(Cells(i, hucre.Column), Cells(i, "AG")), ">4")

      Cells(i, "AP") = say
        End If
    Next
  
    End If
  
    Next
    End If
    Next
    End Sub

 

[mersilen]

Merhaba

Sizin kodların en son kısmına aşağıdaki kodu ekleyin.

Sheets(aktif).Select: Range("A1").Select
End Sub

 

[cerit]

Hocam merhaba,
ellerinize sağlık,sorun çözüldü.
selamlar.

 

[cerit]

Merhaba,
Yukarıda sayın Mersilen'in yazdığı kodlar hücre değeri ">4" ise belirtilen aralıkta sayıyor sorun yok.Belirtilen aralıkta "R"(rapor),"İ"(izin) varsa nasıl saydırırım.
Selamlar.

 

[cerit]

Merhaba,
Sorunumu mevcut kod'a aşağıdaki ilaveyi yaparak çözdüm.
Eski,

Cells(i, "AO") = WorksheetFunction.CountIf(Range("AB" & i & ":AF" & i), ">4")
say = WorksheetFunction.CountIf(Range(Cells(i, hucre.Column), Cells(i, "AF")), ">4")

Yeni,

Cells(i, "AO") = WorksheetFunction.CountIf(Range("AB" & i & ":AF" & i), ">4") + WorksheetFunction.CountIf(Range("AB" & i & ":AF" & i), "İ") + WorksheetFunction.CountIf(Range("AB" & i & ":AF" & i), "R")
say = WorksheetFunction.CountIf(Range(Cells(i, hucre.Column), Cells(i, "AF")), ">4") + WorksheetFunction.CountIf(Range(Cells(i, hucre.Column), Cells(i, "AF")), "İ") + WorksheetFunction.CountIf(Range(Cells(i, hucre.Column), Cells(i, "AF")), "R")

Selamlar.