Calcolo dei turni

Hai un problema con Excel?

Nuova discussione

Calcolo dei turni
di trump61 data: 17/04/2015 19:04:41
Ciao a tutti, sono di nuovo qui perchè ho creduto di aver terminato il mio file invece ho scoperto che fa degli errori.Questi sotto sono codici che avete gia' visto mi fanno degli errori che non sono riuscito a spiegarmi. Praticamente devono formattare nel foglio dove viene inserito il risultato finale e contare il numero di agenti presenti nei tre turni Mattina, Pomeriggio, Notte, sia in ordinario nella prima colonna, straordinario seconda colonna, e lavorazioni extra nella terza. il conteggio non tiene conto delle righe azzurre e degli agenti dopo il 33, mi sembrava che tutto funzionasse invece dopo varie prove solo nel conteggio delle M sbaglia, ho provato a mettere tutte M e mi da 26 in tutte le colonne che è il risultato giusto, ma quando vado ad inserire i turni effettivi nelle tre ultime colonne parte a contare da -1 o - 2 e non sono riuscito a capire perchè.
Vi ringrazio anticipatamente per un vostro aiuto

Questi sono nei fogli
Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
 Range("A4").Value = "X"
 Else
If CheckBox1.Value = False Then
Range("A4").Value = ""
 End If
 End If
End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Range("A4") = "" Then Exit Sub
Dim dh, lh As Range
Dim col As Integer
Dim rig As Long
For col = 3 To 23
   For rig = 5 To 37
If Mid(Cells(rig, col), 1, 1) = "N" Then
  Set dh = Cells(rig, col)
      With dh.Characters(Start:=1, Length:=1).Font
        .FontStyle = "Grassetto"
        .Size = 10
      End With
    With dh.Characters(Start:=3, Length:=12).Font
        .FontStyle = "Normale"
        .Size = 8
     End With
  Else
  If Mid(Cells(rig, col), 3, 1) <> "" Then
  Set lh = Cells(rig, col)
      With lh.Characters(Start:=3, Length:=12).Font
        .FontStyle = "Normale"
        .Size = 8
        
    End With
 End If
End If
   Next
   Next
   Festivita
   CS104
   polipo
   anguilla
   murena

End Sub

Questi sono nei moduli
Sub murena()
Dim T, G, C, D, B, J, TA, CA As Variant 'Mattina
Dim S, Q, R, F, FA, RA, FB, RB As Variant 'Notte
Dim Z, K, W, A, WA, AA, WB, AB As Variant 'Pomerigio

For col = 3 To 9
  T = 0                                            ' Inizio Mattina
  For Each C In Range(Cells(5, ((col - 2) * 3) + 1), Cells(12, ((col - 2) * 3) + 1))
    If Mid(C.Text, 1, 1) = "M" Then T = T + 1
      Next
  G = 0
  For Each D In Range(Cells(18, ((col - 2) * 3) + 1), Cells(20, ((col - 2) * 3) + 1))
    If Mid(D.Text, 1, 1) = "M" Then G = G + 1
  Next
  TA = 0
  For Each CA In Range(Cells(24, ((col - 2) * 3) + 1), Cells(37, ((col - 2) * 3) + 1))
    If Mid(CA.Text, 1, 1) = "M" Then TA = TA + 1
      Next
  TB = 0
  For Each CB In Range(Cells(22, ((col - 2) * 3) + 1), Cells(22, ((col - 2) * 3) + 1))
    If Mid(CB.Text, 1, 1) = "M" Then TB = TB + 1
      Next
    Cells(46, ((col - 2) * 3) + 1) = G + T + TA + TB  'Fine Mattina
  '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  CL = 0                    ' Inizio Pomeriggio
  For Each CB In Range(Cells(5, ((col - 2) * 3) + 1), Cells(12, ((col - 2) * 3) + 1))
    If Mid(CB.Text, 1, 1) = "P" Then CL = CL + 1
  Next
  CC = 0
  For Each CD In Range(Cells(18, ((col - 2) * 3) + 1), Cells(20, ((col - 2) * 3) + 1))
    If Mid(CD.Text, 1, 1) = "P" Then CC = CC + 1
  Next
  CE = 0
  For Each CF In Range(Cells(24, ((col - 2) * 3) + 1), Cells(37, ((col - 2) * 3) + 1))
    If Mid(CF.Text, 1, 1) = "P" Then CE = CE + 1
  Next
  CR = 0
  For Each CV In Range(Cells(22, ((col - 2) * 3) + 1), Cells(22, ((col - 2) * 3) + 1))
    If Mid(CV.Text, 1, 1) = "P" Then CR = CR + 1
  Next
  Cells(47, ((col - 2) * 3) + 1) = CC + CE + CR + CL
  ' Fine pomeriggio
  '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  ZA = 0                         ' inizio notte
  For Each ZB In Range(Cells(5, ((col - 2) * 3) + 1), Cells(12, ((col - 2) * 3) + 1))
    If Mid(ZB.Text, 1, 1) = "N" Then ZA = ZA + 1
  Next
  ZW = 0
  For Each ZD In Range(Cells(18, ((col - 2) * 3) + 1), Cells(20, ((col - 2) * 3) + 1))
    If Mid(ZD.Text, 1, 1) = "N" Then ZW = ZW + 1
  Next
  ZS = 0
  For Each ZD In Range(Cells(24, ((col - 2) * 3) + 1), Cells(37, ((col - 2) * 3) + 1))
    If Mid(ZD.Text, 1, 1) = "N" Then ZS = ZS + 1
  Next
  ZK = 0
  For Each ZH In Range(Cells(22, ((col - 2) * 3) + 1), Cells(22, ((col - 2) * 3) + 1))
    If Mid(ZH.Text, 1, 1) = "N" Then ZK = ZK + 1
  Next
  Cells(45, ((col - 2) * 3) + 1) = ZA + ZK + ZS + ZW
Next
End Sub

Sub anguilla()
Dim T, G, C, D, B, J, TA, CA 'Mattina
Dim S, Q, R, F, FA, RA, FB, RB 'Notte
Dim Z, K, W, A, WA, AA, WB, AB 'Pomerigio

For col = 3 To 9
  T = 0                                            ' Inizio Mattina
  For Each C In Range(Cells(5, ((col - 2) * 3) + 2), Cells(12, ((col - 2) * 3) + 2))
    If Mid(C.Text, 1, 1) = "M" Then T = T + 1
      Next
  G = 0
  For Each D In Range(Cells(18, ((col - 2) * 3) + 2), Cells(20, ((col - 2) * 3) + 2))
    If Mid(D.Text, 1, 1) = "M" Then G = G + 1
  Next
  TA = 0
  For Each CA In Range(Cells(24, ((col - 2) * 3) + 2), Cells(37, ((col - 2) * 3) + 2))
    If Mid(CA.Text, 1, 1) = "M" Then TA = TA + 1
      Next
  TB = 0
  For Each CB In Range(Cells(22, ((col - 2) * 3) + 2), Cells(22, ((col - 2) * 3) + 2))
    If Mid(CB.Text, 1, 1) = "M" Then TB = TB + 1
      Next
 
  Cells(46, ((col - 2) * 3) + 2) = G + T + TA + TB  'Fine Mattina
  '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  CL = 0                    ' Inizio Pomeriggio
  For Each CB In Range(Cells(5, ((col - 2) * 3) + 2), Cells(12, ((col - 2) * 3) + 2))
    If Mid(CB.Text, 1, 1) = "P" Then CL = CL + 1
  Next
  CC = 0
  For Each CD In Range(Cells(18, ((col - 2) * 3) + 2), Cells(20, ((col - 2) * 3) + 2))
    If Mid(CD.Text, 1, 1) = "P" Then CC = CC + 1
  Next
  CE = 0
  For Each CF In Range(Cells(24, ((col - 2) * 3) + 2), Cells(37, ((col - 2) * 3) + 2))
    If Mid(CF.Text, 1, 1) = "P" Then CE = CE + 1
  Next
  CR = 0
  For Each CV In Range(Cells(22, ((col - 2) * 3) + 2), Cells(22, ((col - 2) * 3) + 2))
    If Mid(CV.Text, 1, 1) = "P" Then CR = CR + 1
  Next
  Cells(47, ((col - 2) * 3) + 2) = CC + CE + CR + CL
  ' Fine pomeriggio
  '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  ZA = 0                         ' inizio notte
  For Each ZB In Range(Cells(5, ((col - 2) * 3) + 2), Cells(12, ((col - 2) * 3) + 2))
    If Mid(ZB.Text, 1, 1) = "N" Then ZA = ZA + 1
  Next
  ZW = 0
  For Each ZD In Range(Cells(18, ((col - 2) * 3) + 2), Cells(20, ((col - 2) * 3) + 2))
    If Mid(ZD.Text, 1, 1) = "N" Then ZW = ZW + 1
  Next
  ZS = 0
  For Each ZD In Range(Cells(24, ((col - 2) * 3) + 2), Cells(37, ((col - 2) * 3) + 2))
    If Mid(ZD.Text, 1, 1) = "N" Then ZS = ZS + 1
  Next
  ZK = 0
  For Each ZH In Range(Cells(22, ((col - 2) * 3) + 2), Cells(22, ((col - 2) * 3) + 2))
    If Mid(ZH.Text, 1, 1) = "N" Then ZK = ZK + 1
  Next
  Cells(45, ((col - 2) * 3) + 2) = ZA + ZK + ZS + ZW
Next

End Sub

Sub polipo()
   
Dim T, G, C, D, B, J, TA, CA 'Mattina
Dim S, Q, R, F, FA, RA, FB, RB 'Notte
Dim Z, K, W, A, WA, AA, WB, AB 'Pomerigio

For col = 3 To 9
  T = 0                                            ' Inizio Mattina
  For Each C In Range(Cells(5, (col - 2) * 3), Cells(12, (col - 2) * 3))
    If Mid(C.Text, 1, 1) = "M" Then T = T + 1
      Next
  G = 0
  For Each D In Range(Cells(18, (col - 2) * 3), Cells(20, (col - 2) * 3))
    If Mid(D.Text, 1, 1) = "M" Then G = G + 1
  Next
  TA = 0
  For Each CA In Range(Cells(24, (col - 2) * 3), Cells(37, (col - 2) * 3))
    If Mid(CA.Text, 1, 1) = "M" Then TA = TA + 1
      Next
  TB = 0
  For Each CB In Range(Cells(22, (col - 2) * 3), Cells(22, (col - 2) * 3))
    If Mid(CB.Text, 1, 1) = "M" Then TB = TB + 1
      Next
  BT = 0
  For Each BV In Range(Cells(5, col), Cells(37, (col - 2) * 3))
    If Mid(BV.Text, 1, 2) = "Ma" Then BT = BT + 1
  Next
  Cells(46, (col - 2) * 3) = G + T + TA + TB - BT 'Fine Mattina
  '++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  CL = 0                    ' Inizio Pomeriggio
  For Each CB In Range(Cells(5, (col - 2) * 3), Cells(12, (col - 2) * 3))
    If Mid(CB.Text, 1, 1) = "P" Then CL = CL + 1
  Next
  CC = 0
  For Each CD In Range(Cells(18, (col - 2) * 3), Cells(20, (col - 2) * 3))
    If Mid(CD.Text, 1, 1) = "P" Then CC = CC + 1
  Next
  CE = 0
  For Each CF In Range(Cells(24, (col - 2) * 3), Cells(37, (col - 2) * 3))
    If Mid(CF.Text, 1, 1) = "P" Then CE = CE + 1
  Next
  CR = 0
  For Each CV In Range(Cells(22, (col - 2) * 3), Cells(22, (col - 2) * 3))
    If Mid(CV.Text, 1, 1) = "P" Then CR = CR + 1
  Next
  Cells(47, (col - 2) * 3) = CC + CE + CR + CL
  ' Fine pomeriggio
  '+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  ZA = 0                         ' inizio notte
  For Each ZB In Range(Cells(5, (col - 2) * 3), Cells(12, (col - 2) * 3))
    If Mid(ZB.Text, 1, 1) = "N" Then ZA = ZA + 1
  Next
  ZW = 0
  For Each ZD In Range(Cells(18, (col - 2) * 3), Cells(20, (col - 2) * 3))
    If Mid(ZD.Text, 1, 1) = "N" Then ZW = ZW + 1
  Next
  ZS = 0
  For Each ZD In Range(Cells(24, (col - 2) * 3), Cells(37, (col - 2) * 3))
    If Mid(ZD.Text, 1, 1) = "N" Then ZS = ZS + 1
  Next
  ZK = 0
  For Each ZH In Range(Cells(22, (col - 2) * 3), Cells(22, (col - 2) * 3))
    If Mid(ZH.Text, 1, 1) = "N" Then ZK = ZK + 1
  Next
  Cells(45, (col - 2) * 3) = ZA + ZK + ZS + ZW
Next

End Sub



Sub Festivita()
'
' grassetto Macro
'
Dim dh As Range
Dim col As Integer
Dim rig As Long
'Dim col, rig, As Variant
For col = 3 To 23
   For rig = 5 To 37
If Mid(Cells(rig, col), 1, 1) = "F" Then
  Set dh = Cells(rig, col)
      With dh.Characters(Start:=1, Length:=1).Font
        .ColorIndex = "9"
        .FontStyle = "Grassetto"
        .Size = 10
        
    End With
   
   End If
   Next
   Next
End Sub

Sub CS104()
'
Dim dh As Range
Dim col As Integer
Dim rig As Long
'Dim col, rig, As Variant
For col = 3 To 23
   For rig = 5 To 37
If Mid(Cells(rig, col), 1, 6) = "CS 104" Then
  Set dh = Cells(rig, col)
      With dh.Characters(Start:=1, Length:=6).Font
        .ColorIndex = "9"
        .FontStyle = "Grassetto"
        .Size = 10
        
    End With
   
   End If
   Next
   Next
End Sub

Sub riformatta()
'
' riformatta Macro
'

'
Range("C5:W47").Select
    Selection.ClearContents
    Range("C5:W37").Select
    Selection.Font.Bold = False
    With Selection.Font
        .Name = "Arial"
        .Size = 10
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .ThemeFont = xlThemeFontNone
    End With
    Range("A3").Select
End Sub

di trump61 data: 18/04/2015 18:28:55
Ciao sono ancora io, ho in parte risolto il problema ma l' ho fatto modificando la dicitura Malato usando la m minuscola, da codice non sono riuscito a trovare il modo per differire la M di mattina con la Ma di malato, Ho cercato di trovare un modo per distinguere con il codice i due termini ma non ci sono riuscito, sono sicuro che c'è il modo ma con le mie conoscenze non ci sono riuscito se avete dei suggerimenti sarebbero graditi, ho provato ad esempio a mettere :
T = 0
For Each C In Range(Cells(5, (col - 2) * 3), Cells(12, (col - 2) * 3))
If Mid(C.Text, 1, 1) = "M" + Mid(C.Text, 1, 2) <> "a" Then T = T + 1
Next
o
T = 0
For Each C In Range(Cells(5, (col - 2) * 3), Cells(12, (col - 2) * 3))
If Mid(C.Text, 1, 1) = "M" + Mid(C.Text, 1, 2) = "" Then T = T + 1
Next

Ma non funziona

di Mister_x (utente non iscritto) data: 18/04/2015 19:13:15
ciao

inserire sempre
Option Explicit
Option Compare Binary

Option Explicit
controlla se ai inserito le variabili esatte
Option Compare Binary
distingue da maiuscole a minuscole
M e diverso da m

mentre compare text M = m

quindi metti all'iniziozio sempre
Option Explicit
Option Compare Binary

ciao

Option Explicit
Option Compare Binary
Sub murena()
Dim T, G, C, D, B, J, TA, CA As Variant 'Mattina
Dim S, Q, R, F, FA, RA, FB, RB As Variant 'Notte
Dim Z, K, W, A, WA, AA, WB, AB As Variant 'Pomerigio

Option Explicit
Option Compare Binary
Private Sub CheckBox1_Click()
If CheckBox1.Value = True Then
 Range("A4").Value = "X"
 Else

di trump61 data: 18/04/2015 20:16:15
ti ringrazio del tuo interessamento. L' errore me lo fa in questa parte del routine polipo:
BT = 0
For Each BV In Range(Cells(5, col), Cells(37, (col - 2) * 3))
If Mid(BV.Text, 1, 2) = "Ma" Then BT = BT + 1

Cells(46, (col - 2) * 3) = G + T + TA + TB - BT 'Fine Mattina
Next
per fare una prova ho messo la stessa turnazione del Lunedì in tutta la settimana, e praticamente Lunedì e Martedi conta 6 M correttamente, Mercoledì 5 invece da 6 Giovedì e Venerdì 4 invece di 6 sabato 3 invece di 6 e Domenica 2 invece di 6, e questo non riesco capire perchè succede, nelle parti dei pomeriggi e Notti fa le somme corrette per tutta la settimana non capisco proprio
di Mister_x (utente non iscritto) data: 18/04/2015 20:50:20
ciao

hai provato ad inserire
Option Explicit ????
se si vedrai che ti verra segnalato, anzi segnalati errori di variabili non dichiarate,
fai la prova, quanodo sei in VB nella sub() che deve fare questo lavoro vedrai che ti verranno segnalati errori di variabili non segnalate

prima cosa le variabili vanno sempre dichiarate per utilizzarle al meglio del suo lavoro

ciao
di trump61 data: 18/04/2015 22:06:40
Hai ragione c'erano vari errori, ma non risolvono il mio problema, devo ammettere che avevo fatto un bel casotto, avevo dichiarato Variabili che poi non ho usato e usato altre non dichiarate

di Mister_x (utente non iscritto) data: 19/04/2015 12:20:24
ciao

in base alla tua sub(polipo) ho preferito scriverne una nuova per fare questo lavoro
denominata Sub MioLavoro, questa sostituisce il funzionamento della tua, lasciando le specifiche uquali ai tuoi calcoli

da come vedi la mia si riduce ad un solo ciclo for i con step 3, e ad un for each

ciao

Dim cella As Variant
Dim Ntot As Long, Mtot As Long, Ptot As Long
Dim i As Long
Ntot = 0
Mtot = 0
Ptot = 0
For i = 3 To 21 Step 3 '' ad ogni ciclo salta di 3 colonne 3,6,9,12,15,18,21
  For Each cella In Range(Cells(5, i), Cells(43, i))
    If Mid(cella, 1, 1) = "N" Then Ntot = Ntot + 1
    If Mid(cella, 1, 1) = "M" Then Mtot = Mtot + 1
    If Mid(cella, 1, 1) = "P" Then Ptot = Ptot + 1
  Next
  Cells(45, i) = Ntot
  Cells(46, i) = Mtot
  Cells(47, i) = Ptot
  Ntot = 0
Mtot = 0
Ptot = 0
Next i
End Sub

di Mister_x (utente non iscritto) data: 19/04/2015 12:23:24
ciao
si e' perso un pezzo di sub

Sub MioCalcolo()
''Dim R5_R43 As Range
Dim cella As Variant
Dim Ntot As Long, Mtot As Long, Ptot As Long
Dim i As Long
Ntot = 0
Mtot = 0
Ptot = 0
For i = 3 To 21 Step 3
  For Each cella In Range(Cells(5, i), Cells(43, i))
    If Mid(cella, 1, 1) = "N" Then Ntot = Ntot + 1
    If Mid(cella, 1, 1) = "M" Then Mtot = Mtot + 1
    If Mid(cella, 1, 1) = "P" Then Ptot = Ptot + 1
  Next
  Cells(45, i) = Ntot
  Cells(46, i) = Mtot
  Cells(47, i) = Ptot
  Ntot = 0
Mtot = 0
Ptot = 0
Next i
End Sub

di Mister_x (utente non iscritto) data: 19/04/2015 17:45:44
ciao

ho rivisto un po i tuoi dati e mi sono accorto che tu devi controllare le celle da riga5 a riga 37 escludendo quelle colorate di colore azzurro numero 42 , quindi la sub() con la modifica e'
questa

ciao

Sub MioCalcolo()
''Dim R5_R43 As Range
Dim cella As Variant
Dim Ntot As Long, Mtot As Long, Ptot As Long
Dim i As Long
Ntot = 0
Mtot = 0
Ptot = 0
For i = 3 To 21 Step 3
  For Each cella In Range(Cells(5, i), Cells(37, i))
   If cella.Interior.ColorIndex <> 42 Then
     If Trim(Mid(cella, 1, 2)) = "N" Then Ntot = Ntot + 1
     If Trim(Mid(cella, 1, 2)) = "M" Then Mtot = Mtot + 1
     If Trim(Mid(cella, 1, 2)) = "P" Then Ptot = Ptot + 1
   End If
  Next
  Cells(45, i) = Ntot
  Cells(46, i) = Mtot
  Cells(47, i) = Ptot
  Ntot = 0
Mtot = 0
Ptot = 0
Next i
End Sub

di trump61 (utente non iscritto) data: 20/04/2015 23:25:47
Ciao ti ringrazio per le tue risposte, per motivi di lavoro le ho potute vedere solo ora
di trump61 data: 22/04/2015 02:04:47
Ti ringrazio funziona ho solo dovuto modificare leggermente il codice per fargli contare gli "M1". mi ricordo che avevo iniziato usando anche io Step ma non mi funzionava, sicuramente per mia imperizia, Trim non l'ho mai usata, mi sembra che per l'uso di Step avevo aperto anche una discussione, alla fine avevo usato questo metodo, che non si è rilevato perfetto alla prima malattia di un collega.
Grazie di nuovo
di trump61 data: 22/04/2015 15:38:58
Scusa se ti disturbo di nuovo, in pratica hai usato il colore delle righe che non devo conteggiare, per eliminarle dalle somme?
" If cella.Interior.ColorIndex <> 42 Then " se è così non sapevo si potesse fare o ho capito male?
Grazie di nuovo
di Mister_x (utente non iscritto) data: 22/04/2015 17:27:04
ciao

esatto, ho usato la propieta' colore della cella, visto che tu hai colorato le celle da escludere col colore 42, per non far calcolare queste
altra cosa che forse tu non ai notato ma ti ho lasciato a te decidere,
questa sub la puoi utilizzare su tutte le colonne basta che al ciclo for fai una modifica del tipo
adesso e' cosi
For i = 3 To 21 Step 3
e lo metti a cosi
For i = 3 To 23
e vedrai che con una sola sub() fai tutto dato che il calcolo e sempre quello

ciao
di trump61 data: 22/04/2015 19:33:35
Grazie ne approfitto ancora un po' se posso?
io Ho sempre usato solo next alla fine di un ciclo for,
vedo che tu invece termini con
Next i che sarebbe la variabile usata per il conteggio delle colonne, ma non capisco la differenza tra le due forme.
di Mister_x (utente non iscritto) data: 22/04/2015 23:57:54
ciao

e' possibile anche non metterlo per un ciclo For , ma e bene sempre definirlo per quale ciclo e' predisposto il contatore, per contatore si intende i,o,u o anche ciao
prova ad usare questi quattro cicli racchiusi uno nell'alltro , come ti raccapezzi per sapere quale ciclo stai usando
vedi esempio

mentre
for each non ha nessun contatore ma una variabile,Variant che si riferisce ad un range quindi
next

vedi Help di for s e di for each

altra cosa devi sempre dichiarare le variabili che usi nel loro valore specifico

ciao
for i = 1 to 5 for o = 2 to 5 for u = 7 to 10 for ciao = 0 to 4 ''''a questo punto so che il primo di chiudere e' next ciao next u next o next i
di trump61 data: 23/04/2015 02:56:15
Grazie di nuovo

Vuoi Approfondire?