Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Approfondimento su utilizzo Keeplist

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Approfondimento su utilizzo Keeplist

Postdi BG66 » 28/08/16 07:09

Ciao Anthony,
studiavo e riflettevo sulla tua soluzione al mio thread precedente (http://www.pc-facile.com/forum/viewtopic.php?f=26&t=107327)

E mi chiedevo se detta modalità (keeplist) fosse applicabile anche alla seguente macro (presente nel file postato in precedenza):

Codice: Seleziona tutto
Private Sub Label21_Click() 'Caption= SALVA 1) Inserisce i dati nel Foglio "Anagrafica"; 2) Inserisce i dati nel Foglio "3_SqEmergenza" spuntando con X i vari addetti;
'3) Svuota i campi della UserForm; 4) Inserisce i bordi nel Foglio "0_Nuovo assunto" e nel Foglio "3_SqEmergenza"

Dim wks As Worksheet, wks1 As Worksheet, wks2 As Worksheet, wks3 As Worksheet
Dim wks4 As Worksheet, wks5 As Worksheet, wks6 As Worksheet, wks7 As Worksheet
Dim uriga1 As Long, uriga2 As Long, uRiga3 As Long, uRiga4 As Long, uRiga5 As Long, uRiga6 As Long, y As Integer

Set wks = Sheets("Anagrafica")
Set wks1 = Sheets("0_Nuovo assunto")
Set wks2 = Sheets("3_SqEmergenza")
Set wks3 = Sheets("1_Formazione Sicurezza")
Set wks4 = Sheets("2_Aggiornamenti")
Set wks5 = Sheets("4_Addestramento Specifico")
Set wks6 = Sheets("1_Formaz Somm")
Set wks7 = Sheets("Anagrafica (2)")

uriga = wks.Range("A" & Rows.Count).End(xlUp).Row + 1
uRiga6 = wks6.Range("A" & Rows.Count).End(xlUp).Row + 1
uRiga7 = wks7.Range("A" & Rows.Count).End(xlUp).Row + 1
       
  ''INSERIMENTO DATI
 
        If ComboBox6 <> "SOMMINISTRATO" Then 'SE E' DIVERSO DA SOMMINISTRATO
With wks 'Foglio: Anagrafica
              .Cells(3, 1) = 1
              .Cells(uriga, 1) = uriga - 2
              .Cells(uriga, 2) = TextBox15 'data inizio
              .Cells(uriga, 3) = TextBox1 & " " & TextBox2 ' cognome + nome
              .Cells(uriga, 4) = TextBox1 'cognome
              .Cells(uriga, 5) = TextBox2 'nome
              .Cells(uriga, 6) = OptionButton1 'nuovo assunto
              .Cells(uriga, 7) = TextBox12 'data nascita
              .Cells(uriga, 8) = TextBox13 'luogo nascita
              .Cells(uriga, 9) = TextBox14 'codice fiscale
              .Cells(uriga, 10) = ComboBox7 'qualifica
              .Cells(uriga, 11) = ComboBox1 'stabilimento
              .Cells(uriga, 12) = ComboBox3 'ruolo aziendale
              .Cells(uriga, 13) = ComboBox4 'ruolo sicurezza
              .Cells(uriga, 14) = ComboBox5 'titolo di studio
              .Cells(uriga, 15) = ComboBox6 'in forza
End With

With wks1 'Foglio: 0_Nuovo assunto
uriga1 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
       .Range("A" & uriga1).Value = TextBox1 & " " & TextBox2
       .Range("M" & uriga1).Value = Format(TextBox15, "mm/dd/yyyy")
       .Range("N" & uriga1).Value = CDate(TextBox15) + 60  ' ossia TexBox15+60gg
       .Range("O" & uriga1) = Application.WorksheetFunction.Days360(Format(TextBox15, "mm/dd/yyyy"), Date)
                         
End With

    Else ' DIVERSAMENTE (SE E' SOMMINISTRATO)
   
With wks7 'Foglio: Anagrafica (2)
               .Cells(3, 1) = 1
              .Cells(uRiga7, 1) = uRiga7 - 2
               .Cells(uRiga7, 2) = TextBox15   'data inizio
              .Cells(uRiga7, 3) = TextBox1 & " " & TextBox2   ' cognome + nome
              .Cells(uRiga7, 4) = TextBox1   'cognome
              .Cells(uRiga7, 5) = TextBox2   'nome
              .Cells(uRiga7, 6) = OptionButton1   'nuovo assunto
              .Cells(uRiga7, 7) = TextBox12   'data nascita
              .Cells(uRiga7, 8) = TextBox13   'luogo nascita
              .Cells(uRiga7, 9) = TextBox14   'codice fiscale
              .Cells(uRiga7, 10) = ComboBox7   'qualifica
              .Cells(uRiga7, 11) = ComboBox1   'stabilimento
              .Cells(uRiga7, 12) = ComboBox3   'ruolo aziendale
              .Cells(uRiga7, 13) = ComboBox4   'ruolo sicurezza
              .Cells(uRiga7, 14) = ComboBox5   'titolo di studio
              .Cells(uRiga7, 15) = ComboBox6   'in forza
    End With
   
    With wks6 'Foglio: 1_Formaz Somm
                    .Range("A" & uRiga6).Value = TextBox1 & " " & TextBox2
                    .Range("B" & uRiga6).Value = Format(TextBox15, "mm/dd/yyyy")
                    .Range("C" & uRiga6).Value = CDate(TextBox15) + 60  ' ossia TexBox15+60gg
                    .Range("U" & uRiga6) = Application.WorksheetFunction.Days360(Format(TextBox15, "mm/dd/yyyy"), Date)
End With
 
           
    End If
         
 
      With wks2 'Foglio: 3_SqEmergenza
    uriga2 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
        If ComboBox4 = "RLS" Then
            .Cells(uriga2, 1) = TextBox1 & " " & TextBox2
            .Cells(uriga2, 2) = "X"
        ElseIf ComboBox4 = "Addetto alle Emergenze" Then
            .Cells(uriga2, 1) = TextBox1 & " " & TextBox2
            .Cells(uriga2, 3) = "X"
        ElseIf ComboBox4 = "Addetto Antincendio" Then
           .Cells(uriga2, 1) = TextBox1 & " " & TextBox2
            .Cells(uriga2, 4) = "X"
        ElseIf ComboBox4 = "Addetto I Soccorso" Then
            .Cells(uriga2, 1) = TextBox1 & " " & TextBox2
            .Cells(uriga2, 5) = "X"
        End If
    End With
                   
   

    '____________ CODICE INSERISCI BORDI
   
With wks1 'Foglio: 0_Nuovo assunto
    uRow = .Cells(Rows.Count, 1).End(xlUp).Row  'trova l'ultima cella piena nella colonna A
        For y = 7 To uRow  'ciclo che spazzola dalla riga 7 all'ultima piena
            If .Cells(y, 1) <> "" Then  'se le celle della colonna A sono piene
                With .Range("A7:O" & y).Borders  'stabilisce l'intervallo che va dalla cella A7 alla Cella O (numero di riga ultima cella piena)
                    .LineStyle = xlContinuous  'questa riga prevede l'esistenza del bordo
                    .ColorIndex = 12  'questa riga stabilisce il colore del bordo
                    .Weight = 2  'questa riga stabilisce lo spessore del bordo (1  il pi piccolo)
                End With
            End If
        Next
End With

With wks2
    uRow = .Cells(Rows.Count, 1).End(xlUp).Row  'trova l'ultima cella piena nella colonna A
        For y = 5 To uRow  'ciclo che spazzola dalla riga 5 all'ultima piena
            If .Cells(y, 1) <> "" Then  'se le celle della colonna A sono piene
                With .Range("A5:AA" & y).Borders  'stabilisce l'intervallo che va dalla cella A5 alla Cella AA (numero di riga ultima cella piena)
                    .LineStyle = xlContinuous  'questa riga prevede l'esistenza del bordo
                    .ColorIndex = 12  'questa riga stabilisce il colore del bordo
                    .Weight = 1  'questa riga stabilisce lo spessore del bordo (1  il pi piccolo)
                End With
            End If
        Next
End With
 
    '____________ CODICE ORDINE ALFABETICO
 
 uRow = wks2.Cells(Rows.Count, 1).End(xlUp).Row
     
     With wks2.Range("A5:AA" & uRow) 'Foglio: 3_SqEmergenza
         .Sort Key1:=wks2.Range("A5"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1
    End With
   
  'wks3 ______1_FormazioneSicurezza_importa dati
With wks3
    uRiga3 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
       .Range("A" & uRiga3).Value = TextBox1 & " " & TextBox2
       .Range("B" & uRiga3).Value = CDate(TextBox15) + 60  ' ossia TexBox15+60gg
          For y = 1 To 28 'oppure basta 1 To 2 ?
            TextBoxy = ""
            ComboBoxy = ""
          Next
          End With
       
    '____ed inserisce i bordi
   
With wks3 'Foglio: 1_Formazione Sicurezza
    uRow = .Cells(Rows.Count, 1).End(xlUp).Row  'trova l'ultima cella piena nella colonna A
        For y = 7 To uRow  'ciclo che spazzola dalla riga 7 all'ultima piena
            If .Cells(y, 1) <> "" Then  'se le celle della colonna A sono piene
                With .Range("A7:AB" & y).Borders  'stabilisce l'intervallo che va dalla cella A7 alla Cella AB (numero di riga ultima cella piena)
                    .LineStyle = xlContinuous  'questa riga prevede l'esistenza del bordo
                    .ColorIndex = 12  'questa riga stabilisce il colore del bordo
                    .Weight = 2  'questa riga stabilisce lo spessore del bordo (1  il pi piccolo)
                End With
            End If
        Next
End With
 
  'wks3 ______1_FormazioneSicurezza_FINE
 
  'wks4 ______2_Aggiornamenti_importa dati
With wks4 'Foglio: 2_Aggiornamenti
    uRiga4 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
       .Range("A" & uRiga4).Value = TextBox1 & " " & TextBox2
          For y = 1 To 28
            TextBoxy = ""
            ComboBoxy = ""
          Next
          End With
       
    '____ed inserisce i bordi
   
With wks4 'Foglio: 2_Aggiornamenti
    uRow = .Cells(Rows.Count, 1).End(xlUp).Row  'trova l'ultima cella piena nella colonna A
        For y = 5 To uRow  'ciclo che spazzola dalla riga 5 all'ultima piena
            If .Cells(y, 1) <> "" Then  'se le celle della colonna A sono piene
                With .Range("A5:AB" & y).Borders  'stabilisce l'intervallo che va dalla cella A5 alla Cella AB (numero di riga ultima cella piena)
                    .LineStyle = xlContinuous  'questa riga prevede l'esistenza del bordo
                    .ColorIndex = 12  'questa riga stabilisce il colore del bordo
                    .Weight = 2  'questa riga stabilisce lo spessore del bordo (1  il pi piccolo)
                End With
            End If
        Next
End With
 
  'wks4 ______2_Aggiornamenti__FINE
 
  'wks5 ______4_Addestramento Specifico_importa dati
With wks5 'Foglio: 4_Addestramento Specifico
    uRiga5 = .Cells(Rows.Count, 1).End(xlUp).Row + 1
       .Range("A" & uRiga5).Value = TextBox1 & " " & TextBox2
End With
       
    '____ed inserisce i bordi
   
With wks5 ' Foglio: 4_Addestramento Specifico
    uRow = .Cells(Rows.Count, 1).End(xlUp).Row  'trova l'ultima cella piena nella colonna A
        For y = 7 To uRow  'ciclo che spazzola dalla riga 7 all'ultima piena
            If .Cells(y, 1) <> "" Then  'se le celle della colonna A sono piene
                With .Range("A7:Z" & y).Borders  'stabilisce l'intervallo che va dalla cella A7 alla Cella Z (numero di riga ultima cella piena)
                    .LineStyle = xlContinuous  'questa riga prevede l'esistenza del bordo
                    .ColorIndex = 12  'questa riga stabilisce il colore del bordo
                    .Weight = 2  'questa riga stabilisce lo spessore del bordo (1  il pi piccolo)
                End With
            End If
        Next
End With
 
  With wks6 ' Foglio: 1_Formaz Somm
    uRow = .Cells(Rows.Count, 1).End(xlUp).Row  'trova l'ultima cella piena nella colonna A
        For y = 7 To uRow  'ciclo che spazzola dalla riga 7 all'ultima piena
            If .Cells(y, 1) <> "" Then  'se le celle della colonna A sono piene
                With .Range("A7:U" & y).Borders  'stabilisce l'intervallo che va dalla cella A7 alla Cella U (numero di riga ultima cella piena)
                    .LineStyle = xlContinuous  'questa riga prevede l'esistenza del bordo
                    .ColorIndex = 12  'questa riga stabilisce il colore del bordo
                    .Weight = 2  'questa riga stabilisce lo spessore del bordo (1  il pi piccolo)
                End With
            End If
        Next
End With

With wks7 ' Foglio: Anagrafica (2)
    uRow = .Cells(Rows.Count, 1).End(xlUp).Row  'trova l'ultima cella piena nella colonna A
        For y = 3 To uRow  'ciclo che spazzola dalla riga 3 all'ultima piena
            If .Cells(y, 1) <> "" Then  'se le celle della colonna A sono piene
                With .Range("A3:O" & y).Borders  'stabilisce l'intervallo che va dalla cella A3 alla Cella O (numero di riga ultima cella piena)
                    .LineStyle = xlContinuous  'questa riga prevede l'esistenza del bordo
                    .ColorIndex = 12  'questa riga stabilisce il colore del bordo
                    .Weight = 2  'questa riga stabilisce lo spessore del bordo (1  il pi piccolo)
                End With
            End If
        Next
End With
 
  For y = 1 To 21
            TextBoxy = ""
            ComboBoxy = ""
          Next y
         
   
MsgBox "Dato inserito correttamente!"

Set wks = Nothing
Set wks1 = Nothing
Set wks2 = Nothing
Set wks3 = Nothing
Set wks4 = Nothing
Set wks5 = Nothing
Set wks6 = Nothing
Set wks7 = Nothing

End Sub


Grazie in anticipo della tua risposta.
BG66
Excel2010
BG66
Utente Junior
 
Post: 21
Iscritto il: 20/08/16 07:44

Sponsor
 

Re: Approfondimento su utilizzo Keeplist

Postdi Anthony47 » 30/08/16 01:54

Nella discussione precedente keepList era una variabile usata per contenere un elenco di nomi foglio, che dovevano essere esclusi dal processo di cancellazione che la macro effettuava.
Lo stesso concetto puo' essere usato in qualsiasi contesto in cui ci sia da fare cose logicamente analoghe, altrimenti va individuato un algoritmo diverso.

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13892
Iscritto il: 21/03/06 16:03
Località: Ivrea


Torna a Applicazioni Office Windows


Topic correlati a "Approfondimento su utilizzo Keeplist":


Chi c’è in linea

Visitano il forum: Nessuno e 20 ospiti