Ok Flash grazie comunque.
Mi sai dare qualche consiglio su come potrei impostarlo più facilmente?
Moderatori: Anthony47, Flash30005
ti consiglio di rivedere bene tutto quanto e poi partire, pensare subito alla formula ... è sconsigliabile al massimo.FLASH ha scritto:... bisogna fare una bella analisi proprio perché più è studiato lo schema di input e output dei dati più si semplifica la realizzazione del programma.
Sub PrgTurni()
UCT = Worksheets("PreTurni").Range("IV2").End(xlToLeft).Column
For RRT = 14 To 53
For CCT = 2 To UCT
If Cells(RRT, CCT).Value = 5 Then Cells(RRT, CCT).Clear
Next CCT
Next RRT
For ColT = 2 To UCT
For RRL = 5 To 9
Select Case RRL
Case 5
Colore = 65535
Case 6
Colore = 5287936
Case 7
Colore = 16737792
Case 8
Colore = 11711154
Case 9
Colore = 16776960
End Select
NumP = Cells(RRL, ColT).Value
For RT = 1 To NumP
If RT = 1 Then
If Cells(RRL + 9, ColT).Value = "" Then
Cells(RRL + 9, ColT).Value = 5
Cells(RRL + 9, ColT).Interior.Color = Colore
Else
Cells(RRL + 9 + 5, ColT).Value = 5
Cells(RRL + 9 + 5, ColT).Interior.Color = Colore
End If
Else
Ripr:
RCas = Int(Rnd(30) * 30) + 24
MyC = Evaluate("=Min(PreTurni!P24:P53)")
If ColT Mod 2 = 0 Then
If Cells(RCas, 16).Value = MyC And Cells(RCas, ColT).Value = "" Then
Cells(RCas, ColT).Value = 5
Cells(RCas, ColT).Interior.Color = Colore
Else
GoTo Ripr
End If
Else
If Cells(RCas, 16).Value = MyC And Cells(RCas, ColT).Value = "" And Cells(RCas, ColT - 1).Value = "" Then
Cells(RCas, ColT).Value = 5
Cells(RCas, ColT).Interior.Color = Colore
Else
GoTo Ripr
End If
End If
End If
Next RT
Next RRL
Next ColT
End Sub
Sub PrgTurni()
NomeF = ActiveSheet.Name
Set Ws1 = Worksheets(NomeF)
UCT = Ws1.Range("IV2").End(xlToLeft).Column
URT = Ws1.Range("A" & Rows.Count).End(xlUp).Row
Rep = ""
Ws1.Range("B14:O53").Interior.ColorIndex = xlNone
For RRT = 14 To 53
For CCT = 2 To UCT
If UCase(Ws1.Cells(RRT, CCT).Value) <> "NO" Then
Ws1.Cells(RRT, CCT).ClearContents
End If
Next CCT
Next RRT
For ColT = 2 To UCT
Turno = 1
If ColT Mod 2 = 1 Then Turno = 2
For RRL = 5 To 9
Select Case RRL
Case 5
Colore = 6
Rep = "A"
Case 6
Colore = 50
Rep = "B"
Case 7
Colore = 41
Rep = "C"
Case 8
Colore = 15
Rep = "D"
Case 9
Colore = 8
Rep = "E"
End Select
NumP = Ws1.Cells(RRL, ColT).Value
For RT = 1 To NumP
If RT = 1 Then
If Ws1.Cells(RRL + 9, ColT).Value = "" Then
Ws1.Cells(RRL + 9, ColT).Value = Turno & Rep
Ws1.Cells(RRL + 9, ColT).Interior.ColorIndex = Colore
Else
Ws1.Cells(RRL + 14, ColT).Value = Turno & Rep
Ws1.Cells(RRL + 14, ColT).Interior.ColorIndex = Colore
End If
Else
Ripr:
RCas = Int(Rnd(30) * 30) + 24
If UCase(Mid(Ws1.Cells(RCas, 1).Value, 1, 4)) <> "COLL" Then GoTo Ripr
MyC = Evaluate("=Min(" & NomeF & "!P24:P" & URT & ")")
If Ws1.Cells(RCas, 16).Value <> MyC Or Ws1.Cells(RCas, ColT).Value <> "" Then GoTo Ripr
If Turno = 2 And Ws1.Cells(RCas, ColT - 1).Value <> "" Then GoTo Ripr
Ws1.Cells(RCas, ColT).Value = Turno & Rep
Ws1.Cells(RCas, ColT).Interior.ColorIndex = Colore
End If
Next RT
Next RRL
Next ColT
End Sub
Sub PulisciCampi()
Range("B14:O53").Interior.ColorIndex = xlNone
Range("B14:O53").ClearContents
End Sub
=(14-CONTA.SE(B14:O14;"")-CONTA.SE(B14:O14;"=no"))*5
=SE(STRINGA.ESTRAI(A24;1;4)="Coll";(14-CONTA.SE(B24:O24;"")-CONTA.SE(B24:O24;"=no"))*5;"")
Sub PrgTurni()
NomeF = ActiveSheet.Name
Set Ws1 = Worksheets(NomeF)
UCT = Ws1.Range("IV2").End(xlToLeft).Column
URT = Ws1.Range("A" & Rows.Count).End(xlUp).Row
Rep = ""
Ws1.Range("B14:O53").Interior.ColorIndex = xlNone
For RRT = 14 To 53
For CCT = 2 To UCT
If UCase(Ws1.Cells(RRT, CCT).Value) <> "NO" Then
Ws1.Cells(RRT, CCT).ClearContents
End If
Next CCT
Next RRT
For ColT = 2 To UCT
Turno = 1
If ColT Mod 2 = 1 Then Turno = 2
For RRL = 5 To 9
Select Case RRL
Case 5
Colore = 6
Rep = "A"
Case 6
Colore = 50
Rep = "B"
Case 7
Colore = 41
Rep = "C"
Case 8
Colore = 15
Rep = "D"
Case 9
Colore = 8
Rep = "E"
End Select
NumP = Ws1.Cells(RRL, ColT).Value
For RT = 1 To NumP
If RT = 1 Then
If Ws1.Cells(RRL + 9, ColT).Value = "" Then
Ws1.Cells(RRL + 9, ColT).Value = Turno & Rep
Ws1.Cells(RRL + 9, ColT).Interior.ColorIndex = Colore
Else
Ws1.Cells(RRL + 14, ColT).Value = Turno & Rep
Ws1.Cells(RRL + 14, ColT).Interior.ColorIndex = Colore
End If
Else
Ripr:
RCas = Int(Rnd(30) * 30) + 24
If UCase(Mid(Ws1.Cells(RCas, 1).Value, 1, 4)) <> "COLL" Then GoTo Ripr
MyC = Evaluate("=Min(" & NomeF & "!P24:P" & URT & ")")
If Ws1.Cells(RCas, 16).Value <> MyC Or Ws1.Cells(RCas, ColT).Value <> "" Then GoTo Ripr
If Turno = 2 And Ws1.Cells(RCas, ColT - 1).Value <> "" And UCase(Ws1.Cells(RCas, ColT - 1).Value) <> "NO" Then GoTo Ripr
Ws1.Cells(RCas, ColT).Value = Turno & Rep
Ws1.Cells(RCas, ColT).Interior.ColorIndex = Colore
End If
Next RT
Next RRL
Next ColT
End Sub
For ColT = 2 To UCT '<<<< lasciare com'è
Turno = "10-15" '<<<<<<<<<<<<< modificata
If ColT Mod 2 = 1 Then Turno = "15-20" '<<<< modificata
Torna a Applicazioni Office Windows
Macro copia dati colonne non contigue su un altro file excel Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 5 |
Excel: formula automatica per evidenziare prodotto scaduto Autore: gamma_ray |
Forum: Applicazioni Office Windows Risposte: 3 |
Salvare file excel in formato html escludendo le immagini Autore: systemcrack |
Forum: Applicazioni Office Windows Risposte: 10 |
Visitano il forum: Anthony47 e 17 ospiti