Bisognerebbe fare un'analisi più approfondita perché in effetti dire almeno una volta a settimana non significa ogni sette giorni ma possono divenire 13, purché al 14 ci sia un'altra presenza.
Comunque ho imbastito questa macro.
Provala su un file nuovo
In A1 scrivi "Paziente"
Inserisci da A2 verso il basso e metti delle X all'interno della tabella
poi avvia la macro "CompilaMese"
- Codice: Seleziona tutto
Sub CompilaMese()
Anno = Year(Now)
Mese = Month(Now)
Range("B2:AF1").ClearContents
For Giorno = 1 To 31
If Month(DateSerial(Anno, Mese, Giorno)) > Mese Or Day(DateSerial(Anno, Mese, Giorno)) > Day(Now) Then GoTo esci
UC = Range("IV1").End(xlToLeft).Column + 1
Cells(1, UC).Value = DateSerial(Anno, Mese, Giorno)
Cells(1, UC).NumberFormat = "dd"
Next Giorno
esci:
Call Controlla
End Sub
Sub Controlla()
Columns("AG:AG").ClearContents
UR = Range("A" & Rows.Count).End(xlUp).Row
UC = Range("IV1").End(xlToLeft).Column
Periodo = Int(UC / 7)
For RR = 2 To UR
If RR = 7 Then MsgBox RR
Conta = 0
ContaX = 0
MConta = 0
For CC = 2 To UC
If UC - 1 < 7 Then Range("AG" & RR).Value = "Ok"
Conta = Conta + 1
If Conta > MConta Then MConta = Conta
If UCase(Cells(RR, CC).Value) = "X" Then
Conta = 0
ContaX = ContaX + 1
End If
Next CC
If UC - 1 < 14 And ContaX >= 1 Then
Range("AG" & RR).Value = "Ok"
GoTo salta
End If
If UC - 1 < 21 And (ContaX >= 2 Or MConta < 13) Then
Range("AG" & RR).Value = "Ok"
GoTo salta
Else
Range("AG" & RR).Value = "No"
End If
If UC - 1 < 28 And (ContaX >= 3 Or MConta < 13) Then
Range("AG" & RR).Value = "Ok"
GoTo salta
Else
Range("AG" & RR).Value = "No"
End If
salta:
Next RR
End Sub
Se ci sono problemi posta ancora
ciao