listbox con due com...
 
Notifiche
Cancella tutti

La consultazione del forum è libera per tutti.

Per poter porre un quesito è invece necessario essere un utente registrato (clicca qui se non lo sei).

Tutti gli utenti che richiedono un supporto, come da REGOLAMENTO, sono caldamente invitati ad allegare un file di esempio con l'indicazione di quello che si desidera ottenere.

listbox con due combobox per filtro dati

10 Post
2 Utenti
0 Reactions
190 Visualizzazioni
Forum 1
(@cyberlady)
Post: 48
Trusted Member
Avviatore di Topic
 

Ciao, oggi vi presento un altro problemino...nel file allegato sono riuscita a realizzare una userform che..BLOCCA EXCEL! Sono diventata brava eh 🤣 

Parliamo della userform ReportOperai, dove dovrei filtrare i dati presenti nel foglio rapporti_lavoro filtrandoli con due combobox in modo da ottenere nella listbox l'elenco delle ore lavorate da un particolare operaio in un particolare cantiere. non arrivo a capire dove sia l'errore perchè non mi parte nemmeno il debug, si blocca excel e basta. 

Grazie in anticipo per l'aiuto

 

Versione di Excel
Sistema operativo
 
Postato : 04/06/2025 12:18
Alexps81
(@alexps81)
Post: 33
Eminent Member
 

Ciao @Cyberlady prova a sostituire tutto ciò che hai scritto nella UserForm ReportOperai con queste procedure e vedi se fa quello che vorresti:

Option Explicit

Private Sub UserForm_Initialize()
    caricaCantiere
    caricaDipendenti
End Sub

Private Sub caricaCantiere()
    Dim ws As Worksheet
    Dim ur As Long, i As Long
    Dim dictCantiere As Object
    Dim cantiere As String
    Dim arrCantiere() As Variant
    
    Set ws = ThisWorkbook.Worksheets("rapporti_lavoro")
    Set dictCantiere = CreateObject("Scripting.Dictionary")
    
    ur = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    If ur > 1 Then
        For i = 2 To ur
            cantiere = Trim(ws.Range("A" & i).Value)
            If cantiere <> "" And Not dictCantiere.Exists(cantiere) Then
                dictCantiere.Add cantiere, cantiere
            End If
        Next i
        
        If dictCantiere.Count > 0 Then
            arrCantiere = dictCantiere.Items
            Me.ComboBox1.List = OrdinaArray(arrCantiere)
        End If
    End If
    
    Set ws = Nothing
    Set dictCantiere = Nothing
End Sub

Private Sub caricaDipendenti()
    Dim ws As Worksheet
    Dim ur As Long, i As Long
    Dim dictDipendenti As Object
    Dim dipendente As String
    Dim arrDipendente() As Variant
    
    Set ws = ThisWorkbook.Worksheets("rapporti_lavoro")
    Set dictDipendenti = CreateObject("Scripting.Dictionary")
    
    ur = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    
    If ur > 1 Then
        For i = 2 To ur
            dipendente = Trim(ws.Range("C" & i).Value)
            If dipendente <> "" And Not dictDipendenti.Exists(dipendente) Then
                dictDipendenti.Add dipendente, dipendente
            End If
        Next i
        
        If dictDipendenti.Count > 0 Then
            arrDipendente = dictDipendenti.Items
            Me.ComboBox2.List = OrdinaArray(arrDipendente)
        End If
    End If
    
    Set ws = Nothing
    Set dictDipendenti = Nothing
End Sub

Private Function OrdinaArray(arr As Variant) As Variant
    Dim j As Long, k As Long
    Dim temp As Variant
    For j = LBound(arr) To UBound(arr) - 1
        For k = j + 1 To UBound(arr)
            If UCase(arr(j)) > UCase(arr(k)) Then
                temp = arr(j)
                arr(j) = arr(k)
                arr(k) = temp
            End If
        Next k
    Next j
    OrdinaArray = arr
End Function

Private Sub combobox1_change()
    If ComboBox2 <> "" Then Call aggiornalistbox
End Sub

Private Sub combobox2_change()
    If ComboBox1 <> "" Then Call aggiornalistbox
End Sub

Private Sub aggiornalistbox()
    Dim ws As Worksheet
    Dim lastrow As Long, i As Long, r As Integer
    Dim cantiere As String, dipendente As String, firstAddress As String
    Dim f As Range
    Dim dict As Object
    Dim arrDataNomeOre As Variant
    
    Set ws = ThisWorkbook.Sheets("rapporti_lavoro")
    Set dict = CreateObject("Scripting.Dictionary")
    
    lastrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    cantiere = ComboBox1.Value
    dipendente = ComboBox2.Value
    i = 0
    
    Set f = ws.Range("A:A").Find(What:=cantiere, LookIn:=xlValues, LookAt:=xlWhole)
    If Not f Is Nothing Then
        firstAddress = f.Address
        Do
            If f.Offset(, 2).Value = dipendente Then
                arrDataNomeOre = Array(f.Offset(, 1).Value, f.Offset(, 2).Value, f.Offset(, 3).Value)
                i = i + 1
                dict.Add i, arrDataNomeOre
            End If
            Set f = ws.Range("A:A").FindNext(f)
        Loop While Not f Is Nothing And f.Address <> firstAddress
    End If
    
    With ListBox1
        .ColumnCount = 3
        .Clear
        If dict.Count > 0 Then
            For i = 0 To dict.Count - 1
                .AddItem
                For r = 0 To .ColumnCount - 1
                    .List(.ListCount - 1, r) = dict.Items()(i)(r)
                Next r
            Next i
        Else
            MsgBox "Non ci sono dati da mostrare!", vbExclamation, "Attenzione..."
        End If
    End With
    
    Set ws = Nothing
    Set f = Nothing
    Set dict = Nothing
End Sub

Se hai bisogno di spiegazioni fammi sapere.

 
Postato : 04/06/2025 16:30
Alexps81
(@alexps81)
Post: 33
Eminent Member
 

Ciao @Cyberlady ho fatto un piccolo errore nel codice precedente. Ho scambiato le ComboBox. Tieni buono quest'altro codice:

Option Explicit

Private Sub UserForm_Initialize()
    caricaCantiere
    caricaDipendenti
End Sub

Private Sub caricaCantiere()
    Dim ws As Worksheet
    Dim ur As Long, i As Long
    Dim dictCantiere As Object
    Dim cantiere As String
    Dim arrCantiere() As Variant
    
    Set ws = ThisWorkbook.Worksheets("rapporti_lavoro")
    Set dictCantiere = CreateObject("Scripting.Dictionary")
    
    ur = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    If ur > 1 Then
        For i = 2 To ur
            cantiere = Trim(ws.Range("A" & i).Value)
            If cantiere <> "" And Not dictCantiere.Exists(cantiere) Then
                dictCantiere.Add cantiere, cantiere
            End If
        Next i
        
        If dictCantiere.Count > 0 Then
            arrCantiere = dictCantiere.Items
            Me.ComboBox2.List = OrdinaArray(arrCantiere)
        End If
    End If
    
    Set ws = Nothing
    Set dictCantiere = Nothing
End Sub

Private Sub caricaDipendenti()
    Dim ws As Worksheet
    Dim ur As Long, i As Long
    Dim dictDipendenti As Object
    Dim dipendente As String
    Dim arrDipendente() As Variant
    
    Set ws = ThisWorkbook.Worksheets("rapporti_lavoro")
    Set dictDipendenti = CreateObject("Scripting.Dictionary")
    
    ur = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    
    If ur > 1 Then
        For i = 2 To ur
            dipendente = Trim(ws.Range("C" & i).Value)
            If dipendente <> "" And Not dictDipendenti.Exists(dipendente) Then
                dictDipendenti.Add dipendente, dipendente
            End If
        Next i
        
        If dictDipendenti.Count > 0 Then
            arrDipendente = dictDipendenti.Items
            Me.ComboBox1.List = OrdinaArray(arrDipendente)
        End If
    End If
    
    Set ws = Nothing
    Set dictDipendenti = Nothing
End Sub

Private Function OrdinaArray(arr As Variant) As Variant
    Dim j As Long, k As Long
    Dim temp As Variant
    For j = LBound(arr) To UBound(arr) - 1
        For k = j + 1 To UBound(arr)
            If UCase(arr(j)) > UCase(arr(k)) Then
                temp = arr(j)
                arr(j) = arr(k)
                arr(k) = temp
            End If
        Next k
    Next j
    OrdinaArray = arr
End Function

Private Sub combobox1_change()
    If ComboBox2 <> "" Then Call aggiornalistbox
End Sub

Private Sub combobox2_change()
    If ComboBox1 <> "" Then Call aggiornalistbox
End Sub

Private Sub aggiornalistbox()
    Dim ws As Worksheet
    Dim lastrow As Long, i As Long, r As Integer
    Dim cantiere As String, dipendente As String, firstAddress As String
    Dim f As Range
    Dim dict As Object
    Dim arrDataNomeOre As Variant
    
    Set ws = ThisWorkbook.Sheets("rapporti_lavoro")
    Set dict = CreateObject("Scripting.Dictionary")
    
    lastrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    dipendente = ComboBox1.Value
    cantiere = ComboBox2.Value
    
    i = 0
    
    Set f = ws.Range("A:A").Find(What:=cantiere, LookIn:=xlValues, LookAt:=xlWhole)
    If Not f Is Nothing Then
        firstAddress = f.Address
        Do
            If f.Offset(, 2).Value = dipendente Then
                arrDataNomeOre = Array(f.Offset(, 1).Value, f.Offset(, 2).Value, f.Offset(, 3).Value)
                i = i + 1
                dict.Add i, arrDataNomeOre
            End If
            Set f = ws.Range("A:A").FindNext(f)
        Loop While Not f Is Nothing And f.Address <> firstAddress
    End If
    
    With ListBox1
        .ColumnCount = 3
        .Clear
        If dict.Count > 0 Then
            For i = 0 To dict.Count - 1
                .AddItem
                For r = 0 To .ColumnCount - 1
                    .List(.ListCount - 1, r) = dict.Items()(i)(r) '<--le due () prima di i e r servono a trasformare gli Item del dizionario in array
                Next r
            Next i
        Else
            MsgBox "Non ci sono dati da mostrare!", vbExclamation, "Attenzione..."
        End If
    End With
    
    Set ws = Nothing
    Set f = Nothing
    Set dict = Nothing
End Sub
 
Postato : 04/06/2025 16:50
Forum 1
(@cyberlady)
Post: 48
Trusted Member
Avviatore di Topic
 

Grazie, appena rientro lo provo…ma tu hai scoperto cos’era che faceva bloccare il programma? Vorrei pian piano riuscire a capire dove sbaglio, non solo correggere con un copia e incolla

 
Postato : 04/06/2025 18:21
Alexps81
(@alexps81)
Post: 33
Eminent Member
 

Ciao. Allora innanzitutto scusami ma mi sono accorto di un altro piccoli errore quindi aspettati  una nuova mia risposta dove ti rigiro il codice corretto per la terza volta.

Ti risponderò anche riguardo il problema che riscontri con il tuo codice...ma se ne parla stasera 

 
Postato : 04/06/2025 18:25
Alexps81
(@alexps81)
Post: 33
Eminent Member
 

Ciao @Cyberlady

divido questa mia risposta in due parti. Nella prima darò delle risposte in merito al tuo codice, nella seconda parte parlerò del mio.

Prima parte

Tanto per iniziare il tuo file è troppo "pesante" e rispetto al suo contenuto, e le dimensioni non si spiegano. Da rigo 1543 in poi, anche se non li vedi, ci sono delle celle con all'interno dei dati. Infatti la variabile lastrow, quando si valorizza, assume come valore un numero gigantesco (non ricordo di preciso ma se ho visto bene siamo verso il milione). Con un numero così grande, capisci bene che quei cicli For in cui viene impegnata quella variabile, il processo diventa lentissimo. 

Per prima cosa fai questa azione, che sarà utile anche per il mio codice. Dunque, nel foglio "rapporti_lavoro", fai click con il mouse sul numero che identifica il rigo 1543. Come puoi vedere adesso quel rigo è interamente selezionato. A questo punto tieni premuto i pulsanti SHIFT + CTRL e con la freccia direzionale verso il basso, seleziona tutte le righe (a partire quindi dalla 1543) fino all'ultima del foglio. Con le righe selezionate, premi il tasto CANC. Adesso tutti i dati superflui presenti, sono cancellati.

Adesso salva il file e chiudilo. Se nella cartella dove risiede il file premi il tasto F5, noterai che il file da oltre 18 Mb, passa a poco più di 100 Kb.

Se apri di nuovo il file, noterai che non si blocca più come dicevi, ma purtroppo il tuo codice non funziona come dovrebbe. Quindi passiamo ad esaminarlo.

Non so se già altre volte l'ho fatto notare, ma in cima ad ogni modulo (che sia uno Modulo Standard o del Foglio), devi sempre mettere la scritta Option Explicit (dichiarazione esplicita delle variabili). Se lo avessi fatto anche in questa occasione, il compilatore ti avrebbe segnato subito la prima anomalia, ovvero, nell'evento Initialize della UserForm c'è una discrepanza con la variabile lastrow perché nel primo ciclo For (quello che serve a caricare la Combobox1) è dichiarata lastros 

Una cosa che però non mi torna è che tu nella UserForm, secondo come descritto dalle Etichette di fianco ad ogni ComboBox, sembra che tu voglia caricare i Dipendenti nella ComboBox1 e i Cantieri nella ComboBox2, ma di fatto con quel doppio ciclo For carichi i Cantieri nella ComboBox1 e le Date nella ComboBox2. Quindi o hai commesso un errore nell'indicare le colonne da dove attingere i dati oppure hai sbagliato ad indicare le Etichette.

Tralasciando per ora questo problema, personalmente io preferisco utilizzare una Dictionary piuttosto che una Collection per caricare in modo univoco i dati (cosa che a quanto sembra tu voglia fare). La Dictionary ha il proprio metodo .Exists che valuta la presenza o meno del dato (che nel gergo viene definito key), mentre la Collection non ha un metodo nativo, infatti tu hai dovuto aggirare il problema gestendolo con On Error Resume Next.

Passiamo alla Sub aggiornalistbox(). Qui onestamente non ho capito cosa pensavi di fare scrivendo così la macro. In altre parole, attraverso un ciclo For che scorre fino all'ultima riga compilata in colonna "A", stai cercando di caricare in ListBox gli elementi presenti in colonna "B", "C" e "D" ma solo se le variabili filtrocategoria e filtrosottocategoria sono entrambe vuote. Queste due variabili si valorizzano del contenuto delle due ComboBox.

Io invece da quello che mi è sembrato di capire, tu vorresti scegliere il Cantiere e il Dipendente attraverso le due ComboBox, in base alle scelte, mostrare in ListBox le date, il nominativo e le ore svolte in quella data. Giusto? (Spero di si perché la mia macro quello fa 😀)

Seconda parte

Come accennato, la mia macro fa proprio quanto su descritto. Nelle varie procedure ti ho commentato ogni rigo, in modo che tu possa capire il funzionamento:

Option Explicit '<--dichiarazione esplicita delle varibili _
                    (è anche possibile attivarla in modo permanente andando in: _
                    STRUMENTI, OPZIONI, spunta su DICHIARAZIONI DI VARIABILI OBBLIGATORIA

Private Sub UserForm_Initialize()
'utilizzo di 2 SUB per caricare le ComboBox.
'utile perché può essere necessario in seguito richiamare il loro caricamento
    caricaCantiere
    caricaDipendenti
End Sub

Private Sub caricaCantiere()
'procedura che carica la ComboBox2 (Cantieri)
    Dim ws As Worksheet
    Dim ur As Long, i As Long
    Dim dictCantiere As Object
    Dim cantiere As String
    Dim arrCantiere() As Variant
    
    'imposto il foglio
    Set ws = ThisWorkbook.Worksheets("rapporti_lavoro")
    
    'imposto un Dizionario per la raccolta dei valori (Cantieri)
    Set dictCantiere = CreateObject("Scripting.Dictionary")
    
    'calcolo l'ultimo rigo compilato in colonna "A" (dove risiedono i nomi dei Cantieri)
    ur = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    'se l'ultimo rigo è superiore ad 1, allora esistono dati, quindi carico i dati
    If ur > 1 Then
        'con un ciclo, scorro da rigo 2 fino all'ultimo rigo
        For i = 2 To ur
            'in una variabile prelevo il nome del cantiere scritto nella cella iterata.
            'utilizzo la funzione TRIM per eliminare eventuali spazi prima e dopo
            cantiere = Trim(ws.Range("A" & i).Value)
            
            'se il cantiere esiste (ovvero la cella iterata non è vuota) e non è ancora stato scritto nel Dizionario (ecco il metodo .Exists)...
            If cantiere <> "" And Not dictCantiere.Exists(cantiere) Then
                'allora lo scrivo nel Dizionario. La chiave (key) sarà il nome del cantiere, così come anche il valore (item)
                dictCantiere.Add cantiere, cantiere
            End If
        Next i
        
        'se il Dizionario contiene valori...
        If dictCantiere.Count > 0 Then
            'allora trasferisco i valori del Dizionario in un Array
            'è necessario perché voglio ordinare l'elenco dei valori
            arrCantiere = dictCantiere.Items
            
            'utilizzo una Function chiamata OrdinaArray, che non è altro che un BobbleSort
            'come parametro gli passo l'Array dei valori presi dal Dizionario
            'una volta che il BobbleSort avrà ordinato i valori, essi verranno utilizzati per caricare la ComboBox2 (Cantieri)
            Me.ComboBox2.List = OrdinaArray(arrCantiere) '<--qui il codice salta nella Function OrdinaArray che è scritta più giù
        End If
    End If
    
    'libero la memoria dagli oggetti creati
    Set ws = Nothing
    Set dictCantiere = Nothing
End Sub

Private Sub caricaDipendenti()
'procedura che carica la ComboBox1 (Dipendenti)
'stessa identica procedure della ComboBox2, ma si opera sulla colonna "C"
    Dim ws As Worksheet
    Dim ur As Long, i As Long
    Dim dictDipendenti As Object
    Dim dipendente As String
    Dim arrDipendente() As Variant
    
    Set ws = ThisWorkbook.Worksheets("rapporti_lavoro")
    Set dictDipendenti = CreateObject("Scripting.Dictionary")
    
    ur = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    
    If ur > 1 Then
        For i = 2 To ur
            dipendente = Trim(ws.Range("C" & i).Value)
            If dipendente <> "" And Not dictDipendenti.Exists(dipendente) Then
                dictDipendenti.Add dipendente, dipendente
            End If
        Next i
        
        If dictDipendenti.Count > 0 Then
            arrDipendente = dictDipendenti.Items
            Me.ComboBox1.List = OrdinaArray(arrDipendente)
        End If
    End If
    
    Set ws = Nothing
    Set dictDipendenti = Nothing
End Sub

Private Function OrdinaArray(arr As Variant) As Variant
'funzione che ordina alfabeticamente i valori (BoobleSort)
    Dim j As Long, k As Long
    Dim temp As Variant
    
    'attraverso un doppio ciclo, scorro a partire dall'indice minimo dall'Array arr (definito come parametro nella Function)
    'fino all'indice massimo dell'Array arr - 1 (LBound serve per determinare l'indice minimo, UBound quello massimo)
    'ad esempio se arr ha 100 elementi, allora il primo ciclo andrà da 0 a 99
    For j = LBound(arr) To UBound(arr) - 1
        'secondo ciclo che va dall'indice minimo dell'Array arr + 1 fino all'indice massimo
        'qui il ciclo andrà da 1 a 100
        For k = j + 1 To UBound(arr)
            'siccome nell'Array arr ho tutti i valori (ad esempio ho tutti i Cantieri presi in modo univoco),
            'valuto se il nome del primo cantiere e maggiore del secondo cantiere
            'ad esempio CASTELFONDO è maggiore di ACCIAIERIE, quindi...
            If UCase(arr(j)) > UCase(arr(k)) Then '(UCase serve per valuare i nomi i valutandoli in maiuscolo)
                'dato che CASTELFONDO è maggiore di ACCIAIERIE
                temp = arr(j) 'trasferisco temporaneamente ACCIAIERIE in un una varibile d'appoggio
                arr(j) = arr(k) 'sposto CASTELFONDO in posizione successiva
                arr(k) = temp 'sposto ACCIAIERIE in posizione precedente
            End If
            'faccio questi spostamenti finché non ordino tutto l'Array
        Next k
    Next j
    'a questo punto, terminata l'operazione, la Function OrdinaArray mi ritorna l'Array ordinato
    OrdinaArray = arr
End Function

Private Sub combobox1_change()
'al cambiamento della ComboBox1, valuto se la ComboBox2 non è vuota.
'se non lo è allora aggiorno la ListBox
'quindi entrambe le ComboBox devono essere valorizzate
    If ComboBox2 <> "" Then Call aggiornalistbox
End Sub

Private Sub combobox2_change()
'al cambiamento della ComboBox2, valuto se la ComboBox1 non è vuota.
'se non lo è allora aggiorno la ListBox
'quindi entrambe le ComboBox devono essere valorizzate
    If ComboBox1 <> "" Then Call aggiornalistbox
End Sub

Private Sub aggiornalistbox()
'procedura per popolare la ListBox
    Dim ws As Worksheet
    Dim lastrow As Long, i As Long, r As Integer
    Dim cantiere As String, dipendente As String, firstAddress As String
    Dim f As Range
    Dim arrDataNomeOre As Variant
    
    'imposto il Foglio
    Set ws = ThisWorkbook.Sheets("rapporti_lavoro")
    
    'determino l'ultima riga compilata
    lastrow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row

    dipendente = ComboBox1.Value 'il dipendente assume il valore della ComboBox1
    cantiere = ComboBox2.Value 'il cantiere assume il valore della ComboBox2
    
    With ListBox1
        .ColumnCount = 3 'imposto 3 colonne alla ListBox
        .Clear 'cancello i vecchi valori
        
        'con il metodo Find di Range, cerco il Cantiere nella colonna "A"
        Set f = ws.Range("A:A").Find(What:=cantiere, LookIn:=xlValues, LookAt:=xlWhole)
        'se esiste il Cantiere...
        If Not f Is Nothing Then
            'prelevo in una variabile l'indirizzo di cella del primo cantiere che ha trovato
            'questo servirà quando dovrò cercare gli altri cantieri,
            'perché poi dovrà cercare fin quando non ritorna al primo indirizzo di cella (fistAddress)
            firstAddress = f.Address
            Do
                'se rispetto al cantiere trovato, risulta in colonna "C" (Offset(, 2).Value) il dipendente indicato in ComboBox1, allora...
                If f.Offset(, 2).Value = dipendente Then
                    'aggiungi un rigo alla ListBox
                    .AddItem
                    'attraverso un ciclo di 3 iterzioni, popola la ListBox in ogni sua colonna
                    For r = 1 To .ColumnCount '<-- r va da 1 a 3 perché prima ho definito che le colonne della ListBox devono essere 3
                        'quindi la prima colonna sarà uguale alla DATA presente in colonna "B" (Offset(, 1) ovvero sposta a destra di un passo rispetto al cantiere trovato)
                        'quindi la seconda colonna sarà uguale al DIPENDENTE presente in colonna "C" (Offset(, 2) ovvero sposta a destra di due passi rispetto al cantiere trovato)
                        'quindi la terza colonna sarà uguale alle ORE presenti in colonna "D" (Offset(, 3) ovvero sposta a destra di tre passi rispetto al cantiere trovato)
                        .List(.ListCount - 1, r - 1) = f.Offset(, r).Value
                    Next r
                End If
            'una volta popolato il primo rigo della ListBox, passiamo al cercare il prossimo cantiere, utilizzando il FindNext
            Set f = ws.Range("A:A").FindNext(f)
            'ripeti la ricerca finché la prossima cella dove risiede il prossimo cantiere è diversa dalla cella del primo cantiere
            'ad esempio se i cantieri sono in A2, A5, A10 e A20...allora firstAddress sarà A2. Con FindNext il prossimo cantiere trovato sarà in A5,
            'poi in A10 ed infine in A20. A quel punto, proseguirebbe cercandolo di nuovo in A2 ma siccome gli diciamo di continuare (Loop) finché
            'l'indirizzo di cella dell'ennesimo cantiere è diverso dall'indirizzo di cella del primo cantiere, allora la ricerca si interromperà
            Loop While Not f Is Nothing And f.Address <> firstAddress
        End If
        'se per caso non esistono dati che si incrociano (Dipendente-Cantiere), allora la ListBox non sarà popolata.
        'a quel punto mostro un messaggio di dati insesistenti
        If .ListCount = 0 Then MsgBox "Non ci sono dati da mostrare!", vbExclamation, "Attenzione..."
    End With
    
    'libero la memoria dagli oggetti creati
    Set ws = Nothing
    Set f = Nothing
End Sub
 
Postato : 05/06/2025 08:22
Forum 1
(@cyberlady)
Post: 48
Trusted Member
Avviatore di Topic
 

@alexps81 funziona perfettamente e anche la tua spiegazione è chiarissima, perfino per me che sono una povera autodidatta agli inizi...ho solo fatto una piccola modifica per visualizzare nella listbox anche la prima colonna. Adesso cercherò di applicare il tuo codice anche per le userform successive, così vedo se ho davvero capito. Grazie ancora!

 
Postato : 05/06/2025 13:08
Alexps81
(@alexps81)
Post: 33
Eminent Member
 

Bene @Cyberlady, visto che utilizzi Office 365, ti propongo questa modifica che già sulla mia versione che è la 2021 funziona. Quindi funzionerà anche sulla tua. Ma se la utilizzi su versioni precedenti alla 2021 non funzionerà.

Di tutte le procedute che ti ho girato, elimina:

  1. la Function OrdinaArray
  2. la Sub caricaDipendenti
  3. la Sub caricaCantiere

rimpiazza queste tre con solo questo codice:

Private Sub caricaCantiere()
'procedura che carica la ComboBox2 (Cantieri)
    Dim ws As Worksheet
    Dim ur As Long, i As Long
    Dim arrUnici As Variant, arrOrdinati As Variant

    'imposto il foglio
    Set ws = ThisWorkbook.Worksheets("rapporti_lavoro")
        
    'calcolo l'ultimo rigo compilato in colonna "A" (dove risiedono i nomi dei Cantieri)
    ur = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    
    'se l'ultimo rigo è superiore ad 1, allora esistono dati, quindi carico i dati univoci e ordinati
    If ur > 1 Then Me.ComboBox2.List = Application.WorksheetFunction.Sort(Application.WorksheetFunction.Unique(ws.Range("A2:A" & ur)))
    
    'libero la memoria dagli oggetti creati
    Set ws = Nothing
End Sub

Private Sub caricaDipendenti()
'procedura che carica la ComboBox1 (Dipendenti)
'stessa identica procedure della ComboBox2, ma si opera sulla colonna "C"
    Dim ws As Worksheet
    Dim ur As Long, i As Long
    Dim arrUnici As Variant, arrOrdinati As Variant
    
    Set ws = ThisWorkbook.Worksheets("rapporti_lavoro")
    
    ur = ws.Cells(ws.Rows.Count, "C").End(xlUp).Row
    
    If ur > 1 Then If ur > 1 Then Me.ComboBox1.List = Application.WorksheetFunction.Sort(Application.WorksheetFunction.Unique(ws.Range("C2:C" & ur)))
    
    Set ws = Nothing
End Sub

In pratica da Office 2021 a Office 2024 (ma non su tutte le Build) e su Office 365 si possono sfruttare le Funzioni Unique (per estrarre valori univoci) e Sort (per ordinare l'elenco).

Fammi sapere se funziona.

Ciao.

 
Postato : 05/06/2025 14:11
Forum 1
(@cyberlady)
Post: 48
Trusted Member
Avviatore di Topic
 

@alexps81 funziona alla grande. Tu invece sai scovare il perchè il comando stampa dia un errore che nella userform ReportCantieri non da? Il codice è identico (ho fatto copia e incolla), il calcolo del totale ore nella textbox anche e funziona benissimo, cambia solo la textbox ma in questa userform mi restituisce "totale" come variabile non definita

Private Sub Stampa_Click()

Dim wsProvvisorio As Worksheet
Dim i As Long, j As Long
Dim ultimariga As Long

On Error Resume Next
Set wsProvvisorio = ThisWorkbook.Sheets("ReportOperai")
If wsProvvisorio Is Nothing Then
Set wsProvvisorio = ThisWorkbook.Sheets.Add
wsProvvisorio.Name = "ReportOperai"
End If
On Error GoTo 0

wsProvvisorio.Cells.Clear

For i = 0 To ListBox1.ListCount - 1
For j = 0 To ListBox1.ColumnCount - 1
wsProvvisorio.Cells(i + 1, j + 1).Value = ListBox1.List(i, j)
Next j
Next i

wsProvvisorio.Columns.AutoFit

totale = Val(Me.TextBox1.Value)
ultimariga = wsProvvisorio.Cells(wsProvvisorio.Rows.Count, 1).End(xlUp).Row + 2
wsProvvisorio.Cells(ultimariga, 3).Value = "Totale ore:"
wsProvvisorio.Cells(ultimariga, 4).Value = totale

Application.Dialogs(xlDialogPrinterSetup).Show
ThisWorkbook.Sheets("ReportOperai").PrintOut copies:=1

Application.DisplayAlerts = False
wsProvvisorio.Delete
Application.DisplayAlerts = True

MsgBox "Stampa completata", vbInformation

End Sub

 
Postato : 06/06/2025 12:35
Alexps81
(@alexps81)
Post: 33
Eminent Member
 

Ciao, sarò lieto di aiutarti appena posso (osa rispondo da cellulare), però credo che dato che si tratta di un altro argomento, se questo è risolto dovresti spuntare come tale e aprirne uno ad hoc.

P.S. nell'ultimo codice che ti ho girato, c'è un refuso: le variabili i As Long, arrUnici As Variant e arrOrdinati As Variant le puoi cancellare in entrambe le Sub. Erano rimaste lì mentre facevo le prove, ma non servono.

 
Postato : 06/06/2025 13:37
Condividi:
My Agile Privacy
Questo sito utilizza cookie tecnici e di profilazione. Cliccando su accetta si autorizzano tutti i cookie di profilazione. Cliccando su rifiuta o la X si rifiutano tutti i cookie di profilazione. Cliccando su personalizza è possibile selezionare quali cookie di profilazione attivare.
Attenzione: alcune funzionalità di questa pagina potrebbero essere bloccate a seguito delle tue scelte privacy
     Scarica il nostro ebook gratuito     

Unisciti a oltre 35.000 professionisti
che hanno già scelto di semplificare il proprio lavoro
e aumentare la produttività con la nostra newsletter!

Scarica l’ebook con i
migliori trucchi e suggerimenti per Excel
selezionati per te da Excel Academy

Download