İki koşullu sayma

[mersilen]

Merhabalar

somproduct formülünü macroda kullanamadığım için

=TOPLA.ÇARPIM((AC$5:AC$35=C$7)*(METNEÇEVİR(AB$5:AB$35;"gggg")=$V11))

AC5:AC35 arasında salı günlerine gelen "C" leri saydırabilmek için döngü kurdum aama döngü hata veriyor,
yardımcı olabilir misiniz?

For y = 5 To 35
       If (Cells(ts, "V")) = Format(Cells(y, "AB"), "dddd") Then
           Range("A24") = Cells(ts, "V")
           If kisi = Cells(y, "AC") Then
                kgn = kgn + 1
                Range("A26") = kgn
                Else
                Cells(20 + y, "B") = "kgn hata:" & y
                
             End If
       End If
    Next y

 

[Ömer]

Merhabalar

somproduct formülünü macroda kullanamadığım için

=TOPLA.ÇARPIM((AC$5:AC$35=C$7)*(METNEÇEVİR(AB$5:AB$35;"gggg")=$V11))

Merhaba,

Bu şekilde deneyin.

Sub Bul_Say()
 
    Dim c As Range, ilkadres As Variant, j As Byte, i As Byte
    
    Range("AG8:AZ14").ClearContents
 
    For j = 8 To 14
      For i = 33 To 52
        With Range("AC5:AC35")
          Set c = .Find(Cells(7, i), , xlValues, xlWhole)
          If Not c Is Nothing Then
            ilkadres = c.Address
              Do
                If Format(Cells(c.Row, "AB"), "dddd") = Cells(j, "BB") Then
                  Cells(j, i) = Cells(j, i) + 1
                End If
                Set c = .FindNext(c)
              Loop While Not c Is Nothing And c.Address <> ilkadres
          End If
        End With
      Next i
    Next j
 
End Sub

.

 

[mersilen]

Ömer bey
bayramınız mübarek olsun

Öncelikle cevap için teşekkürler, siz tablo 3 ü doldurmanın çözümünü üretmişsiniz
yalnız ben tablo1 i tablo 2 ye göre doldurmaya çalışıyorum (elimde 1-2 yıllık kim hangi gün nöbet tutmuş diye bir istatistiğim var, buna göre yaklaşık olarak kimin hangi günü tutması gerektiğini önceden belirliyorum)

Tıkandığım konu döngüler birbiri içinde ilerlerken bazı yerlerde hata veriyor
mesela 2. salı, 2. perşembe gib...

kullandığım formülün özünde

 If Cells(x, "AC") = "" And _
                 Cells(gs, ksu) <> "" And _
                 Cells(gs, ksu) > kgn1 And _
                (WorksheetFunction.CountIf(Range(Cells(x - 3, "AC"), Cells(x + 3, "AC")), kisi) < 1 And _
                (WorksheetFunction.CountIf(Range("AC5:AC35"), kisi) < ((Cells(15, ksu).Value) - 0))) _
            Then
               Cells(x, "AC") = kisi

yukarıda toplaçarpımla yapmaya çalıştığımı
kgn1 olarak çıkardım
kodların tamamıda aşağıda , incelerseniz sevinirim

 'Option Explicit
Private Sub CommandButton1_Click()
Dim x, ts As Integer
Dim gs, ksu As Integer
Dim hucre As Range
Set wsc = Worksheets("sayfa2").Cells: h = 25

Application.ScreenUpdating = False
Application.Calculation = xlManual
For x = 5 To 35
If Cells(x, "AC") = "" Then

     For ts = 8 To 14 ' gün satırı
         If (Cells(ts, "V")) = Format(Cells(x, "AB"), "dddd") Then
            gs = ts  'gün satırı
            wsc(h + x, "A") = Clear: wsc(h + x, "A") = "X=" & x & ";   TS gün:" & ts - 7 & "   " & Format((Cells(ts, "V")), "dddd") & " gün satır:gs:ts: " & gs
            
            Else
            End If
     Next ts
     ts = gs
     wsc(h + x, "B") = "X=" & x & ";   TS gün:" & ts - 7 & "   " & Format((Cells(ts, "V")), "dddd") & "  gs:" & gs & "  ts:" & ts
     For ksu = 1 To 20 'kişi sütunu
     kisi = Cells(7, ksu)
     kgn = 0  'kişinin gün satırında nöbeti
            For y = 5 To 35
            If Cells(x, "AC") = "" And (Cells(ts, "V")) = Format(Cells(y, "AB"), "dddd") Then
                If kisi = Cells(y, "AC") Then
                  kgn = kgn + 1
                  kgn1 = kgn
                Else
                End If
                  wsc(h + x + 5, "B") = kgn1 + 0
           End If
           Next y
              If Cells(x, "AC") = "" And _
                 Cells(gs, ksu) <> "" And _
                 Cells(gs, ksu) > kgn1 And _
                (WorksheetFunction.CountIf(Range(Cells(x - 3, "AC"), Cells(x + 3, "AC")), kisi) < 1 And _
                (WorksheetFunction.CountIf(Range("AC5:AC35"), kisi) < ((Cells(15, ksu).Value) - 0))) _
            Then
               Cells(x, "AC") = kisi
            ElseIf Cells(x, "AC") = "" Then Cells(20 + x, ksu) = "hata x=" & x & "  ts=" & ts & "  ksu:" & ksu 'HATA KONTROL SATIRI
            End If
     Next ksu

Else
End If
Next x
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub

 

[Ömer]

Verdiğim kodların aralıklarını değiştirerek istediğiniz tabloya uyarlayabilirsiniz.

.