Collegamento tra 4 combobox

Hai un problema con Excel?

Nuova discussione

Collegamento tra 4 combobox
di Dodi (utente non iscritto) data: 05/01/2018 18:00:37
Salve a tutti e buon 2018

Volevo porre alla vostra attenzione un ulteriore problema che mi si e presentato e che non so risolvere.
Vi allego un file per capire meglio. Io ho un foglio giornale lavori, dove lanciò una userform che deve prendere i dati dal foglio TABCAN. E qui viene il bello. C'è un modo per collegare delle combobox?
Mi spiego meglio. Se nella combobox cantiere seleziono un cantiere vorrei che le ulteriori 3 combobox (opera, wbs, e sub_wbs ) si popolano e contengono solo i dati di riferimento di quel cantiere, ? Altresi faccio presente che i cantieri possono essere infiniti e non solo quelli che ho descritto nel file esempio. Preciso anche che il formato del foglio e xome da schema file allegato, perche ho altre userform già programmate per archiviare i dati di riferimento e che mi consentono di inserire i dati in quel modo.
Ringrazio anticipatamente tutti indistintamente per l'aiuto.
di mabolsie data: 05/01/2018 18:22:16
Ciao Dodi nel form userei 1 combo principale e 3 label o text box tanto che da il riferimento è la combo le altre sono solo di complemento, giusto?
poi con un cerca.vert. dal dato principale della combo popoli le tre Label o Text.

...naturalmente è un'idea.

Ciao Max
di Dodi (utente non iscritto) data: 05/01/2018 18:41:40
Ciao Max grazie per la risposta.
Forse mi don spiegato male. Con le tex box o label come dici te non risolvo. In pratica sotto ogni cantiere ce opera ,wbs, e sub_wbs, che a loro volta contengono altri dati e selezionando il cantiere nelle combobox di riferimento si popolano con i dati riferiti a quel cantiere.

di Albatros54 data: 05/01/2018 18:49:59
Incolla il codice che ti posto nel modulo della userform.
ciao
albatros54

Private sh As Worksheet
Private col1 As Collection
Private LR As Long

Private Sub Cantiere_Click()
    Dim lng As Long
    Me.Opera.Clear
    With sh
        For lng = 6 To LR
            If .Cells(lng, "c").Value = Me.Cantiere.Text Then
                Me.Opera.AddItem (.Cells(lng, "F").Value)
            End If
        Next
    End With
End Sub

Private Sub Opera_click()
    Me.WBS.Clear
    With sh
        For r = 6 To LR
            If Cells(r, "c") = Me.Cantiere.Text And Cells(r, "f") = Me.Opera.Text Then
                Me.WBS.AddItem (.Cells(r, "G").Value)
            End If
        Next
    End With

End Sub


Private Sub UserForm_Initialize()

    Dim lng As Long

    Set col1 = New Collection
    Set sh = ThisWorkbook.Worksheets(2)

    With sh
        LR = .Range("c" & .Rows.Count).End(xlUp).Row
        For lng = 6 To LR
            On Error Resume Next
            col1.Add CStr(.Cells(lng, "c").Value), CStr(.Cells(lng, "c").Value)
            If Err.Number = 0 Then
                Me.Cantiere.AddItem (.Cells(lng, "c").Value)
            End If
            Err.Number = 0
        Next
    End With

End Sub


Private Sub WBS_Click()
    Me.Sub_wbs.Clear
    With sh
        For r = 6 To LR
            If Cells(r, "c") = Me.Cantiere.Text And Cells(r, "f") = Me.Opera.Text And Cells(r, "g") = Me.WBS.Text Then
                Me.Sub_wbs.AddItem (.Cells(r, "h").Value)
            End If
        Next
    End With
End Sub

di mabolsie data: 05/01/2018 18:52:04
Ah! Ho capito

Ciao Max
di Dodi (utente non iscritto) data: 05/01/2018 18:58:49
Albatros grazie. Leggendo il tuo codice penso che va bene . Attualmente non ho modo di testarlo perché don fuori non appena provo ti faccio sapere.
Intanto grazie
di Dodi (utente non iscritto) data: 05/01/2018 19:19:25
Ciao albatros stavo rileggendo meglio il tuo codice. E mi sembra da comw l'hai scritto che i dati li ricerca in orizontale. O mi sbaglio?
Invece quello che mi serviva e altro e cioè se vedi sulla sinistra ci sono i cantieri in blu. E sotto ogni cantiere ce l opera la wbs e sub_wbs di riferimento, con i relativi dati. Ora se seleziono il cantiere le altre combobox devono cercare i dati in verticale riferiti al cantiere di riferimento. E cambiando cantiere devono cambiare i contenuti della combobox opera wbs e sub_wbs.. prendendo i dati alle colonne di riferimento del cantiwrw di appartenenza. Grazie spero di esser stato più chiaro adesso
di Dodi (utente non iscritto) data: 06/01/2018 00:04:43
Ciao Albatros
Ho avuto modo ora di provare il tuo codice. Ed in effetti quando seleziono il "cantiere" ; nelle combobox opera wbs e sub_wbs cerca i dati in orizzontale. Invece come detto a me serve che i dati nelle combobox opera wbs e sub_wbs li cerca in verticale sotto il cantiere di appartenenza. Perché ogni cantiere ha le 3 colonne di dati e dati sempre diversi.
Resto in attesa di un tuo riscontro o di chi cmq possa aiutarmi a risolvere qsto problema. Purtroppo so che è un bel quesito, anche perché la formattazione del foglio non si può cambiare xché ho già creato un'altra user che all'inserimento di un nuovo cantiere , in automatico mi crea le tre colonne opera wbs e sub_wbs. Ora mi rimane solo da sistemare il quesito sopra descritto.
di mabolsie data: 06/01/2018 09:08:01
tua cit. " In pratica sotto ogni cantiere ce opera ,wbs, e sub_wbs, che a loro volta contengono altri dati e selezionando il cantiere nelle combobox di riferimento si popolano con i dati riferiti a quel cantiere."

Rileggendola bene forse sarebbe più semplice un DataBase Relazionale tipo Access.

Ciao Max
di Dodi (utente non iscritto) data: 06/01/2018 10:21:59
Ciao Max. Beh forse il tuo concetto e giusto. Ma ce modo di risolverlo in Excel?
Penso che un modo ci sia? Per quello mi don rivolto al forum

di Albatros54 data: 06/01/2018 16:17:34
Come prima cosa Excel ODIA l'unione delle celle, per questo le ho separate.
Ti posto il codice sotto da incollare mnel modulo della userform, il codice ti inizializza solo le combox Cantiere e Opera, lascia a te il compito di inizializzare le altre combobox.
Studia il codice e applicalo alle altre combobox.
ciao
albatros54

Private Rng As Range

Private Sub Cantiere_Click()
    Dim finalcol As Integer
    Dim cl As Object
    Dim y As Integer
    Dim finalrow As Integer
    Dim rngattiva() As Variant
    Dim rngWBS() As Variant
    Me.Opera.Clear
    Me.WBS.Clear
    Me.Sub_wbs.Clear
    finalcol = Cells(4, Columns.Count).End(xlToLeft).Column
    For Each cl In Rng
        If cl = Me.Cantiere.Text Then
            cl.Select
            cl.Offset(2, 0).Activate
            y = ActiveCell.Column
            finalrow = Cells(Rows.Count, y).End(xlUp).Row
        End If
    Next
    
    For a = LBound(rngattiva) To UBound(rngattiva)
        Me.Opera.AddItem (rngattiva(a, 1))
    Next a

    ActiveCell.Offset(0, 1).Activate
    finalrowWBS = Cells(Rows.Count, y + 1).End(xlUp).Row
       rngWBS = Range(Cells(6, y + 1), Cells(finalrowWBS, y + 1))
    
    For h = 1 To UBound(rngWBS)
        Me.WBS.AddItem (rngWBS(h, 1))

    Next
End Sub
Private Sub UserForm_Initialize()
    Dim c As Integer
    finalcol = Cells(4, Columns.Count).End(xlToLeft).Column
    Set Rng = Range(Cells(4, 6), Cells(4, finalcol))
    For Each cl In Rng
        If Len(cl) <> 0 Then
            dato = dato & " " & cl
        End If
    Next
    vettoreCantieri = Split(dato)
    For c = 1 To UBound(vettoreCantieri)
        Me.Cantiere.AddItem (vettoreCantieri(c))

      '  txt = txt & vettoreCantieri(c) & vbCrLf
    Next c
    'MsgBox txt
End Sub

di Dodi (utente non iscritto) data: 07/01/2018 14:02:56
Ciao Albatros
Volevo dirti che hai centrato il senso di quello che mi occorreva.
Ma ho 2 problemi.
1) Il primo è che se lanciò la userform nel foglio giornale lavori non mi fa vedere i dati nelle combobox. Mentre se la lancio nel foglio TABCAN le combobox si popolano. Faccio presente che la userform deve attingere ai dati nel foglio TABCAN senza cambiare foglio. Xché far cambiare il foglio lo so fare. Ma non voglio qsto.
Mentre per il secondo problema ho provato a cercar di capire come far comparire i dati anche nella combo wbs e sub_wbs, ma ci ho capito poco visto che ci sono termini di sintassi di codice che non ho mai usato, e visto nelle varie ricerche che ho fatto su internet.
Ora ti chiedo e possibile sistemare il punto 1 e magari scrivermi il codice per la combobox wbs? Cosi poi per la combobox sub_wbs provo io. Grazie e intanto buona domenica

di Albatros54 data: 07/01/2018 17:16:20
Prova a sostituire con il codice sotto
ciao
albatros54

Private sh As Worksheet

Private Sub Cantiere_Click()
    Dim finalcol As Integer
    Dim finalrow As Integer
    Dim rngattiva() As Variant
    Me.Opera.Clear
    Me.WBS.Clear
    Me.Sub_wbs.Clear
    Set sh = Worksheets("TABCAN")
    Application.ScreenUpdating = False

    With sh
        finalcol = .Cells(4, Columns.Count).End(xlToLeft).Column
        Set Rng1 = .Range(.Cells(4, 6), .Cells(4, finalcol))
        For Each cl In Rng1
            If cl = Me.Cantiere.Text Then
                ind = cl.Address(ReferenceStyle:=xlR1C1)
                y = Val(Right(ind, 1))
                finalrow = .Cells(Rows.Count, y).End(xlUp).Row
            End If
        Next

        rngattiva = .Range(.Cells(6, y), .Cells(finalrow, y)).Value

        For a = LBound(rngattiva) To UBound(rngattiva)
            Me.Opera.AddItem (rngattiva(a, 1))

        Next a

        
        finalrowWBS = .Cells(Rows.Count, y + 1).End(xlUp).Row

        rngWBS = .Range(.Cells(6, y + 1), .Cells(finalrowWBS, y + 1))

        For h = 1 To UBound(rngWBS)
            Me.WBS.AddItem (rngWBS(h, 1))

        Next
    End With
    Application.ScreenUpdating = True
End Sub


Private Sub UserForm_Initialize()
    Dim c As Integer
    Set sh = Worksheets("TABCAN")
    Application.ScreenUpdating = False
    With sh
        finalcol = .Cells(4, Columns.Count).End(xlToLeft).Column
        Set Rng = .Range(.Cells(4, 6), .Cells(4, finalcol))
        For Each cl In Rng
            If Len(cl) <> 0 Then
                dato = dato & " " & cl
            End If
        Next
        vettoreCantieri = Split(dato)
        For c = 1 To UBound(vettoreCantieri)
            Me.Cantiere.AddItem (vettoreCantieri(c))

        Next c

    End With
    Application.ScreenUpdating = True
End Sub

di Dodi (utente non iscritto) data: 07/01/2018 18:37:37
Codice testato
Va bene fino alla selezione del cantiere "prova1"
Poi se selezione il cantiere "prova2 o prova3 e così via C'è qualcosa che non va. Puoi dargli un occhio?
Il codice per la sub_wbs l'ho scritto e funziona fino al cantiere prova 1, ma quando vado a selezionare i cantieri dopo il cantiere prova 1 ho notato che non seleziona i dati delle colonne di riferimento.
Sbaglio io qualcosa ho ce un intoppo nel codice di partenza?

di Albatros54 data: 07/01/2018 18:56:23
Ho riscontrato un intoppo,perche quando il numero delle colonne è a due o piu cifre , il codice non va bene.
Comunque ti posto la funzione che po devi richiamare nel codice principale.
in un modulo incolla la funzione "NumeroColonna", e aggiungi la riga sotto , al corpo del codice postato.
Cioa
Albatros54

Function NumeroColonna(ByVal stringa As String) As Integer
cont = 0
For N = 1 To Len(stringa)
If IsNumeric(Right(stringa, N)) Then
cont = cont + 1
End If
Next
cont = Right(stringa, cont)
NumeroColonna = cont
End Function


For Each cl In Rng1
            If cl = Me.Cantiere.Text Then
                ind = cl.Address(ReferenceStyle:=xlR1C1)
                y = NumeroColonna(ind) 'Val(Right(ind, 1))
                finalrow = .Cells(Rows.Count, y).End(xlUp).Row
            End If
        Next

di Dodi (utente non iscritto) data: 07/01/2018 21:00:35
Ho fatto come mi hai detto ma continuo a riscontrare problemi nel selezionare il cantiere. E Cioè se nella combobox cantiere selezione il cantiere "prova2"
Nelle rispettive combobox opera wbs e sub_wbs non compaiono i dati di riferimento.
Mi sa che facciamo prima se mi sistemi te il file e me lo rigiri.
Forse sbaglio io qualcosa.

di Albatros54 data: 08/01/2018 16:16:14
Ciao Dodi, sono stato sempre contrario a fortnire la soluzione finale, perchè non impariamo mai un tubo.
Ti posto il codice con i vari commenti , cerca di applicarlo al tuo progetto ,perchè se segui la logica del codice, capirai come inserire i dati nelle varie combobox,
comunque, noi siamo sempre qua, uno sforzo maggiore da parte tua.
ciao
albatros54

Private Sub UserForm_Initialize()
    Dim c As Integer
'  metto il riferimento al foglio TABCAN
    Set sh = Worksheets("TABCAN")
' Setto al False l'aggiornamento del video, evito lo sfarfallio di Excel
    Application.ScreenUpdating = False
' con il foglio ("TABCAN")
    With sh
' trovo l'ultima colonna che contiene un dato, partendo dalla riga 4
        finalcol = .Cells(4, Columns.Count).End(xlToLeft).Column
'  setto il Range che va dalla R4C6 alla R4C(finalcol)
        Set Rng = .Range(.Cells(4, 6), .Cells(4, finalcol))
, per ciascuna cella contenuta nel range Rng controlla che
        For Each cl In Rng
' Se la lunghezza del valore contenuto in cl(cella) è <>0, quindi c'è un valore
            If Len(cl) <> 0 Then
' crea un stringa separando i valori da uno spazio
                dato = dato & " " & cl
            End If
' continua
        Next
' trasformo la stringa dato in un Vettore
        vettoreCantieri = Split(dato)
' ciclo  tutti i valori del Vettore da 1 fino alla fine
        For c = 1 To UBound(vettoreCantieri)
' e li aggiungo alla combobox Cantiere
            Me.Cantiere.AddItem (vettoreCantieri(c))
' continua
        Next c
'chiudo il ciclo with
    End With
' aggiorno il video
    Application.ScreenUpdating = True
End Sub


Private Sub Cantiere_Click()
    Dim finalcol As Integer
    Dim finalrow As Integer
    Dim rngattiva() As Variant
    Me.Opera.Clear
    Me.WBS.Clear
    Me.Sub_wbs.Clear
    Set sh = Worksheets("TABCAN")
    Application.ScreenUpdating = False

    With sh
        finalcol = .Cells(4, Columns.Count).End(xlToLeft).Column
        Set Rng1 = .Range(.Cells(4, 6), .Cells(4, finalcol))
        For Each cl In Rng1
' Se Cl è uguale al valore che  ho selezionato dalla combobox Cantiere
            If cl = Me.Cantiere.Text Then
'  dammi l'indirizzo della cella che contiene il valore in formato R1C1
                ind = cl.Address(ReferenceStyle:=xlR1C1)
' passo il valore dell'indirizzo della cella alla funzione NumeroColonna(), perchè ho bisogno 
' del valore Numerico della colonna, che assegno a y
                y = NumeroColonna(ind) 'Val(Right(ind, 1))
                finalrow = .Cells(Rows.Count, y).End(xlUp).Row
            End If
        Next

        rngattiva = .Range(.Cells(6, y), .Cells(finalrow, y)).Value

        For a = LBound(rngattiva) To UBound(rngattiva)
            Me.Opera.AddItem (rngattiva(a, 1))

        Next a

' mi sposto di una colonna a Dx per trovarmi i valori di WBS        
        finalrowWBS = .Cells(Rows.Count, y + 1).End(xlUp).Row

        rngWBS = .Range(.Cells(6, y + 1), .Cells(finalrowWBS, y + 1))

        For h = 1 To UBound(rngWBS)
            Me.WBS.AddItem (rngWBS(h, 1))

        Next
    End With
    Application.ScreenUpdating = True
End Sub


Function NumeroColonna(ByVal stringa As String) As Integer

' passo alla funzione il valore dell'indirizzo della cella come stringa
' e cicla la lunghezza della stringa
    For N = 1 To Len(stringa)
' se il valore N della stringa è un numero
        If IsNumeric(Right(stringa, N)) Then
' sommalo a cont
            cont = cont + 1
        Else
' altrimenti esci
            Exit For
        End If
    Next
' colonnafinale sara uguale al numero(cont)dei caratteri a presi a partire da DX caratteri
    colonnafinale = Right(stringa, cont)
    MsgBox colonnafinale
    NumeroColonna = colonnafinale
End Function

di Dodi (utente non iscritto) data: 08/01/2018 18:58:41
Condivido quello che hai scritto.
Cmq grazie per ora. Non appena posso
E lo finisco lo pubblico.
di Dodi (utente non iscritto) data: 09/01/2018 13:07:50
Ciao Albatros
Ho avuto solo ora un Po di tempo per provare a far comparire i dati nella combobox sub_wbs e ci son riuscito a farli comparire posto il codice. Ma mi succede una cosa. E Cioè i dati nella combobox me li replica. Dove sbaglio?
Finalcolsub_wbs=.cells(Rows.Count,y+1).End(xlup). Row Rngsub_wbs=..Range(.cells(6,y+2),.cells(finalcolsub_wbs,y+2)) For x =1 to UBound(rngsub_wbs) Me.sub_wbs.AddItem (rngsub_wbs(x,1) Next
di Dodi (utente non iscritto) data: 09/01/2018 13:11:59
Errore trovato e risolto.
In pratica i Next che chiudevano il cicli li mettevo tutti alla fine invece ogni ciclo andava chiuso a se.

Grazie per l'aiuto.
di Albatros54 data: 09/01/2018 13:33:02

Vuoi Approfondire?