ciao
non sono esperto di vba
comunque qualcosa ho fatto
se poi qualcuno lo vuole semplificare va bene.
a) guarda il foglio dati, ti ho messo delle caselle di spunta.
( la A mi sembra bruttina)
metti la spunta sugli insegnanti che vuoi mantenere
se non c'è la spunta cliccando su RIDUCI LISTA
vengono eliminate le righe.
B) se clicchi su ripristina in colonna A hai i nomi scritti in
ELENCO e in colonna B vengono messe le caselle di spunta.
C)seleziona la cella D5 del foglio ORARI
vai in convalida e mettici
=SCARTO(DATI!$A$1;;;CONTA.SE(DATI!$A$1:$A$837;"<>"&""))
metti la spunta su
"applica le modifiche sulle altre celle con le stesse impostazioni"
fatto.
non eliminare la cella con la scritta insegnanti, è fuori luogo ma se per caso non metti una spunta e clicchi su RIDUCI
la formula da #RIF.
D) nel foglio formule trovi il modo di fare la stessa cosa senza macro
la formula in convalida è uguale cambiano i range.
non sapendo se Aggrega ti funziona ne ho fatte due che si equivalgono.
=SE.ERRORE(INDICE($A$2:$A$300;AGGREGA(15;6;RIF.RIGA($1:$1000)/($B$2:$B$300="A");RIF.RIGA(B1)));"")
=INDICE($A$2:$A$300;PICCOLO(INDICE(SE($B$2:$B$300<>"";RIF.RIGA($A$2:$A$300));0);RIF.RIGA(A1))-1)
quest'ultima deve essere confermata matriciale
quando la copi non cliccare su invio ma su
CTRL MAIUSCOLO INVIO
macro utilizzate
Public Sub ripristina()
Dim lUltRiga As Integer
lUltRiga = Sheets("ELENCO").Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For a = 2 To lUltRiga
Cells(a, 1).ClearContents
Cells(a, 2).ClearContents
Cells(a, 1).Value = Sheets("ELENCO").Cells(a, 1).Value
Next
Application.ScreenUpdating = True
Call check
End Sub
Sub check()
Dim myCheckBox As Object
Dim i As Integer
lUltRiga = Range("A" & Rows.Count).End(xlUp).Row
Application.ScreenUpdating = False
For i = 2 To lUltRiga
With Range("B" & i)
Set myCheckBox = Foglio4.CheckBoxes.Add(.Left, .Top, .Width, .Height)
myCheckBox.Text = ""
myCheckBox.LinkedCell = "B" & i
myCheckBox.Name = "controllo B" & i
End With
Next
Application.ScreenUpdating = True
Call spunta
End Sub
Sub rimuovi_caselle()
On Error Resume Next
ActiveSheet.CheckBoxes.Delete
Selection.FormatConditions.Delete
End Sub
Sub ELIMINA_RIGHE()
Dim UR As Integer
With Sheets("DATI")
Application.ScreenUpdating = False
UR = .Cells(Rows.Count, 2).End(xlUp).Row
For n = UR To 2 Step -1
If .Cells(n, 2).Value = False Then
.Cells(n, 2).EntireRow.Delete
End If
Next n
End With
Application.ScreenUpdating = True
Call rimuovi_caselle
End Sub
Sub Cancella_spunta()
Dim chkBox As Excel.CheckBox
Application.ScreenUpdating = False
For Each chkBox In ActiveSheet.CheckBoxes
chkBox.Value = 0
Next chkBox
Application.ScreenUpdating = True
End Sub
Sub spunta()
Dim chkBox As Excel.CheckBox
Application.ScreenUpdating = False
For Each chkBox In ActiveSheet.CheckBoxes
chkBox.Value = 1
Next chkBox
Application.ScreenUpdating = True
Call Cancella_spunta
End Sub
NB
come apri il file vai in foglio DATI
e clicca su ripristina
vedi che compaiono le caselle di spunta
[Modificato da federico460 28/10/2019 22:19]