Importare dati da una matrice su 2 listbox

Anonimo
2016-06-21T09:57:27+00:00

Buongiorno a tutti,

avrei bisogno di un aiuto nel creare una routine per caricare dei dati in due listbox in funzione di due condizioni.

Venendo al dunque, ho su una userform 3 listbox, nella prima un elenco di nomi e gradi che sono le colonne A e B del foglio di lavoro.

Nelle intestazioni delle altre colonne ci sono 30 corsi in 30 colonne. Nell'incrocio tra le colonne e le righe ho se quel determinato corso è obbligatorio oppura raccomandato per la persona selezionata.

Quindi al momento che clicco su una persona vorrei che una routine spazzoli tutti i corsi ed ad ogni intersezione con la riga mi inserisca quelli obbligatori in una listbox e quelli raccomandati nella seconda listbox. Ovviamente se l'intersezione risulta vuota non aggiunge nessun corso. Spero di essere stato chiaro nella spiegazione e vi allego una parte della tabella con i dati mensionati.

Anticipatamente ringrazio

Saluti

Giuseppe

JOB TITLE SURMANE & NAME PERSONAL SURVIVAL TECNIQUES STCW A-VI/1-1 FIRE PREVENTION AND FIREFIGHTING STCW  A-VI/1-2 ELEMENTARY FIRST AID STCW A-VI/1-3 PERSONAL SAFETY & SOCIAL RESPONSIBILIES STCW A-VI/1-4 PROFICENCY IN SURVIVAL CRAFTS AND RESCUE BOATS (other than fast rescue boat) STCW A-VI/2<br>(7*) ADVANCED FIRE FIGHTING STCW A-VI/3 (7*) FAST RESCUE BOATS STCW  A-VI/2 MEDICAL FIRST AID STCW A-VI/4-1 MEDICAL CARE STCW A-VI/4-2 GMDSS STCW A- IV/2
Master LANGELLA GIUSEPPE M M M M M M M M
Master CASTELLANO GIUSEPPE M M M M M M M M
Chief Mate PITINO SALVATORE M M M M M M R M M
Chief Mate SEKULJA RAJKO M M M M M M R M M
2nd Mate PERSIANO RAFFAELE M M M M M M R R R M
2nd Mate LANDINI ANDREA M M M M M M R R R M
3rd Mate BAZIN ALEKSANDR M M M M M M R R R M
3rd Mate FILIPCIUK ANDREJ M M M M M M R R M
Chief Engineer ANICHINI FEDERICO M M M M M M R
Chief Engineer RIVANO VICTOR M M M M M M R
1st Engineer SOLARI FABIO M M M M M M R R
1st Engineer MORGERA GIUSEPPE M M M M M M R R
2nd Engineer FAVATELLA ANTONIO M M M M M M R R
2nd Engineer LUCIA LUIGI M M M M M M R R
2nd Engineer SENYAK YURIY M M M M R R R R
Microsoft 365 e Office | Excel | Per la casa | Windows

Domanda bloccata. Questa domanda è stata eseguita dalla community del supporto tecnico Microsoft. È possibile votare se è utile, ma non è possibile aggiungere commenti o risposte o seguire la domanda.

0 commenti
Risposta accettata dall'autore della domanda
Anonimo
2016-06-23T00:28:30+00:00

Prova a vedere questo file di esempio (#5) dove alla UserForm ho aggiunto delle ListBox dedicate alle "intestazioni multiple" e dove ho modificato i comandi nell'evento Initialize della user.

Se poi tu volessi impostare anche la larghezza delle colonne potresti dichiarare delle costanti di testo con le misure desiderate e poi assegnare quelle misure alle rispettive TextBox (sia quelle dedicate a contenere i dati veri e propri che quelle dedicate a contenere le intestazioni multiple). In questo modo avresti i dati sempre allineati.

Questo il nuovo file: File esempio #5

Questo il codice, all'interno della User, che ho modificato per tener conto delle ListBox che fanno da intestazione.

'---

Private Sub UserForm_Initialize()

  Dim sLB_Header_MaritimeCrew As Variant

  Dim sLB_Header_CertificateOnBoard As Variant

  Dim sLB_Header_CertificateExpired As Variant

  sLB_Header_MaritimeCrew = Array("Grado", "Cognome e Nome", "Badge Nr")

  sLB_Header_CertificateOnBoard = Array("Certificato", "Data Scadenza")

  sLB_Header_CertificateExpired = Array("Certificato", "Data Scadenza", "Giorni scadenza")

  Set Wb = ThisWorkbook

  With Wb

    Set Ws1 = .Worksheets(sNameWs1)

    Set Ws1Rng1 = Ws1.Range(sWs1Rng1)

    Set CR1 = Ws1Rng1.CurrentRegion

    NumRowCR1 = CR1.Rows.Count

    NumColumnCR1 = CR1.Columns.Count

    Set Ws2 = .Worksheets(sNameWs2)

    Set Ws2Rng1 = Ws2.Range(sWs2Rng1)

    Set CR2 = Ws2Rng1.CurrentRegion

    NumRowCR2 = CR2.Rows.Count

    NumColumnCR2 = CR2.Columns.Count

  End With

  DataOdierna = Date

  With Me

    With .LB_MaritimeCrew

      .List() = CR1.Offset(1, 0).Resize(NumRowCR1 - 1, 3).Value

      .ColumnCount = 3

    End With

    With .LB_Header_MaritimeCrew

      .Column() = sLB_Header_MaritimeCrew

      .ColumnCount = 3

    End With

    With .LB_Header_CertificateOnBoard

      .Column() = sLB_Header_CertificateOnBoard

      .ColumnCount = 2

    End With

    With .LB_Header_CertificateExpired

      .Column() = sLB_Header_CertificateExpired

      .ColumnCount = 3

    End With

    .LB_CertificateOnBoard.ColumnCount = 2

    .LB_CertificateExpired.ColumnCount = 3

  End With

End Sub

'---

p.s. mi sono accorto che avevo nominato la listbox dei certificati scaduti LB_CertificateExipired (con una i dopo la x) e ho provveduto a modificare il nome della TextBox e i relativi riferimenti nel codice con LB_CertificateExpired

p.p.s questo l'aspetto grafico della UserForm con le listbox delle intestazioni colorate di "giallo chiaro"

![](http://fud.community.services.support.microsoft.com/Fud/FileDownloadHandler.ashx?fid=c6cd949e-07d5-4a2d-9cfc-4e1045bce1c3)

La risposta è stata utile?

0 commenti
Risposta accettata dall'autore della domanda
Anonimo
2016-06-22T21:16:50+00:00

Dopo la partita dell'Italia, un po' deludente a dire il vero, ti propongo questo file esempio (il quarto :-) ) dove ho inserito una UserForm2.

File esempio #4

Tutto il codice (così Mauro non mi cazzia :-D) è presente all'interno della UserForm2.

Alle ListBox ho dato dei nomi "particolari" (LB_MaritimeCrew, LB_Mandatory, LB_Racommended, LB_CertificateOnBoard, LB_CertificateExipired).

Questo il codice presente all'interno della UserForm2 (caricabile tramite il pulsante presente nel Foglio1).

'---

Option Explicit

Const sNameWs1 As String = "Foglio1"

Const sWs1Rng1 As String = "A1"

Const sNameWs2 As String = "Foglio2"

Const sWs2Rng1 As String = "A1"

Dim Wb As Workbook

Dim Ws1 As Worksheet

Dim Ws1Rng1 As Range

Dim CR1 As Range

Dim NumRowCR1 As Integer

Dim NumColumnCR1 As Integer

Dim Ws2 As Worksheet

Dim Ws2Rng1 As Range

Dim CR2 As Range

Dim NumRowCR2 As Integer

Dim NumColumnCR2 As Integer

Dim DataOdierna As Date

Private Sub UserForm_Initialize()

  Set Wb = ThisWorkbook

  With Wb

    Set Ws1 = .Worksheets(sNameWs1)

    Set Ws1Rng1 = Ws1.Range(sWs1Rng1)

    Set CR1 = Ws1Rng1.CurrentRegion

    NumRowCR1 = CR1.Rows.Count

    NumColumnCR1 = CR1.Columns.Count

    Set Ws2 = .Worksheets(sNameWs2)

    Set Ws2Rng1 = Ws2.Range(sWs2Rng1)

    Set CR2 = Ws2Rng1.CurrentRegion

    NumRowCR2 = CR2.Rows.Count

    NumColumnCR2 = CR2.Columns.Count

  End With

  DataOdierna = Date

  With Me

    With .LB_MaritimeCrew

      .List() = CR1.Offset(1, 0).Resize(NumRowCR1 - 1, 3).Value

      .ColumnCount = 3

    End With

    .LB_CertificateOnBoard.ColumnCount = 2

    .LB_CertificateExipired.ColumnCount = 3

  End With

End Sub

Private Sub LB_MaritimeCrew_Click()

  Dim sJobTitle As String

  Dim sNomePersonale As String

  Dim rngFindCorsiJobTitle As Range

  Dim rngFindCorsiPersonale As Range

  Dim i As Integer, t As Integer

  With Me

    .LB_Mandatory.Clear

    .LB_Racommended.Clear

    .LB_CertificateOnBoard.Clear

    .LB_CertificateExipired.Clear

  With .LB_MaritimeCrew

    sJobTitle = .List(.ListIndex, 0)

    sNomePersonale = .List(.ListIndex, 1)

  End With

  Set rngFindCorsiJobTitle = CR2.Resize(NumRowCR2, 1).Find(What:=sJobTitle, After:=Ws2Rng1, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)

  Set rngFindCorsiPersonale = CR1.Resize(NumRowCR1, 2).Find(What:=sNomePersonale, After:=Ws1Rng1.Offset(0, 1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)

    For i = 1 To NumColumnCR2 - 1

      If UCase(rngFindCorsiJobTitle.Offset(0, i).Value) = "M" Then

        .LB_Mandatory.AddItem Ws2Rng1.Offset(0, i).Value

      End If

      If UCase(rngFindCorsiJobTitle.Offset(0, i).Value) = "R" Then

        .LB_Racommended.AddItem Ws2Rng1.Offset(0, i).Value

      End If

        For t = 1 To NumColumnCR1 - 3

          If Ws1Rng1.Offset(0, t + 2).Value = Ws2Rng1.Offset(0, i).Value Then

            If rngFindCorsiPersonale.Offset(0, t + 1).Value <> "" Then

              If IsDate(rngFindCorsiPersonale.Offset(0, t + 1).Value) And _

                 UCase(rngFindCorsiJobTitle.Offset(0, i).Value) = "M" Then '<------------

                If rngFindCorsiPersonale.Offset(0, t + 1).Value > DataOdierna + 90 Then

                  With .LB_CertificateOnBoard

                    .AddItem

                    .List(.ListCount - 1, 0) = Ws1Rng1.Offset(0, t + 2).Value

                    .List(.ListCount - 1, 1) = rngFindCorsiPersonale.Offset(0, t + 1).Value

                  End With

                Else

                  With .LB_CertificateExipired

                    .AddItem

                    .List(.ListCount - 1, 0) = Ws1Rng1.Offset(0, t + 2).Value

                    .List(.ListCount - 1, 1) = rngFindCorsiPersonale.Offset(0, t + 1).Value

                    .List(.ListCount - 1, 2) = rngFindCorsiPersonale.Offset(0, t + 1).Value - DataOdierna

                  End With

                End If

              Else

                With .LB_CertificateOnBoard

                  .AddItem

                  .List(.ListCount - 1, 0) = Ws1Rng1.Offset(0, t + 2).Value

                  .List(.ListCount - 1, 1) = rngFindCorsiPersonale.Offset(0, t + 1).Value

                End With

              End If

            Else

              If UCase(rngFindCorsiJobTitle.Offset(0, i).Value) = "M" Then

                With .LB_CertificateExipired

                  .AddItem

                  .List(.ListCount - 1, 0) = Ws1Rng1.Offset(0, t + 2).Value

                  .List(.ListCount - 1, 1) = "To be done"

                  .List(.ListCount - 1, 2) = "!!!!!"

                End With

              End If

            End If

          End If

        Next t

    Next i

  End With

End Sub

'---

Prova a verificare se riesce a fare ciò che è nelle tue intenzioni.

La risposta è stata utile?

0 commenti

68 risposte aggiuntive

Ordina per: Più utili
Più utili Più recente Meno recente
  1. Anonimo
    2016-06-23T08:51:27+00:00

    Ok allora, per quanto riguarda la visualizzazione dei certificati a bordo, basta ignorare quella modifica.

    Per l'altra questione i corsi sono gli stessi?

    Non ho mai utilizzato le "tabstrip" e devo capire come far caricare i dati da un foglio o da un altro :-) (oltre a capire la "logica" del posizionamento delle listbox all'interno della tabstrip) :D

    hai un esempio dei "ruoli" della squadra dei tecnici per avere dei riferimenti diversi?

    La risposta è stata utile?

    0 commenti
  2. Anonimo
    2016-06-23T08:16:47+00:00

    Scusa Casanmaner,

    non avevo capito bene la tua domanda perchè fa esattamente quello che deve fare.

    A me serviva proprio così. Infatti, come da tuo esempio, nella prima listbox evidanzia l'unico con la M, nella seconda niente perchè non ci sono R e nella terza tutti i certificati che il marittimo possiede. Questo è esattamente ciò di cui avevo bisogno e ti spiego il perchè: questi certificati coprono soprattutto determinate mansioni in caso di emergenza. Avendoli tutti sotto controllo potrebbe capitare che per un motivo X una persona facente parte di una squadra anticendio non sia a bordo e quindi avrei un posto vacante nel team. A questo punto mi basterebbe aprire il programma e vedere chi possiede quel certificato anche se per il suo grado attuale non è ne mandatory ne raccomandato. Probabilmente venendo da un'altra piattaforma ha fatto li parte di una fire team e quindi ha ancora il certificato in corso di validità Una volta imbarcato sulla mia piattaforma lo posiziono in un altro ruolo e quindi non mi interessa più la sua certificazione ma è invece interessante avere un quadro generale di tutti i corsi che una persona possiede proprio per quanto detto sopra in caso di bisogno.

    Invece dato che sto inserendo tutti i dati nel nuovo programma, mi è saltato in mente un altro problema.

    Io ho creato due fogli di lavoro come il foglio1.

    Il primo è esattamente quello che ho inviato a voi, mentre il secondo è uguale al primo ma si riferisce al personale tecnico, non più quello marittimo. Ovviamente anche per il personale tecnico ho la stessa tipologia di matrice ma cambiano solo i titoli dei corsi.

    Sulla listbox1 ho aggiunto una tabstrip e vorrei fare in modo che selezionando una delle due tab i gradi, nomi e cognomi cambino ed ovviamente all'evento click vada a trovare i corsi relativi ai tecnici con lo stesso procedimento.

    Ti allego uno screenshoot della tab aggiunta:

    ![](http://fud.community.services.support.microsoft.com/Fud/FileDownloadHandler.ashx?fid=8408624a-042e-4cd7-8ff2-9534a7cbb66d)

    La risposta è stata utile?

    0 commenti
  3. Anonimo
    2016-06-23T07:55:57+00:00

    La condizione che nella testbox dei certificati scaduti (o da fare) viene comunque sempre soddisfatta perché legata alla presenza della condizione M in relazione allo specifico certificato.

    Il "problema" si pone quando nella tabella dei trattamenti dei certificati non è presente né M né R.

    La si tuazione che si crea è che nella textbox dei certificati raccomandati non hai il nome riportato.

    Però, allo stato attuale, il nome del certificato con eventaule data di scadenza, viene riportato tra i certificati presenti a bordo.

    E forse questo potrebbe ingenerare "confusione".

    Per esempio ecco come verrebbe visualizzato se il "grado" master avesse come obbligatorio solo il primo certificato (vedi immagine allegata):

    Nella UserForm avresti tra gli obbligatori solo il primo certificato, tra i raccomandati nessuno.

    Nella listbox dei certificati a bordo verrebbero inseriti anche gli altri certificati per il quali sia indicata una data di scadenza (o anche il testo no exp.).

    Per evitare che eventuali certificati che presentino il campo vuoto nel foglio dei trattamenti vengano riportati tra quelli On Board basta una piccola modifica inserendo una condizione ulteriore.

    Ti riporto il testo dell'evento click della TB dei nominaitivi dell'equipaggio dove quella ulteriore condizione è prente ma "inibita" in quanto sono presenti gli apici che fanno sì che quelle righe vengano lette come testo di commento.

    '---

    Private Sub LB_MaritimeCrew_Click()

      Dim sJobTitle As String

      Dim sNomePersonale As String

      Dim rngFindCorsiJobTitle As Range

      Dim rngFindCorsiPersonale As Range

      Dim i As Integer, t As Integer

      With Me

        .LB_Mandatory.Clear

        .LB_Racommended.Clear

        .LB_CertificateOnBoard.Clear

        .LB_CertificateExpired.Clear

      With .LB_MaritimeCrew

        sJobTitle = .List(.ListIndex, 0)

        sNomePersonale = .List(.ListIndex, 1)

      End With

      Set rngFindCorsiJobTitle = CR2.Resize(NumRowCR2, 1).Find(What:=sJobTitle, After:=Ws2Rng1, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)

      Set rngFindCorsiPersonale = CR1.Resize(NumRowCR1, 2).Find(What:=sNomePersonale, After:=Ws1Rng1.Offset(0, 1), LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows)

        For i = 1 To NumColumnCR2 - 1

          If UCase(rngFindCorsiJobTitle.Offset(0, i).Value) = "M" Then

            .LB_Mandatory.AddItem Ws2Rng1.Offset(0, i).Value

          End If

          If UCase(rngFindCorsiJobTitle.Offset(0, i).Value) = "R" Then

            .LB_Racommended.AddItem Ws2Rng1.Offset(0, i).Value

          End If

            For t = 1 To NumColumnCR1 - 3

              If Ws1Rng1.Offset(0, t + 2).Value = Ws2Rng1.Offset(0, i).Value Then

                If rngFindCorsiPersonale.Offset(0, t + 1).Value <> "" Then

                  If IsDate(rngFindCorsiPersonale.Offset(0, t + 1).Value) And _

                     UCase(rngFindCorsiJobTitle.Offset(0, i).Value) = "M" Then

                    If rngFindCorsiPersonale.Offset(0, t + 1).Value > DataOdierna + 90 Then

                      With .LB_CertificateOnBoard

                        .AddItem

                        .List(.ListCount - 1, 0) = Ws1Rng1.Offset(0, t + 2).Value

                        .List(.ListCount - 1, 1) = rngFindCorsiPersonale.Offset(0, t + 1).Value

                      End With

                    Else

                      With .LB_CertificateExpired

                        .AddItem

                        .List(.ListCount - 1, 0) = Ws1Rng1.Offset(0, t + 2).Value

                        .List(.ListCount - 1, 1) = rngFindCorsiPersonale.Offset(0, t + 1).Value

                        .List(.ListCount - 1, 2) = rngFindCorsiPersonale.Offset(0, t + 1).Value - DataOdierna

                      End With

                    End If

                  Else

                    'If UCase(rngFindCorsiJobTitle.Offset(0, i).Value) <> "" Then '<=== togliere apice inizale qui

                      With .LB_CertificateOnBoard

                        .AddItem

                        .List(.ListCount - 1, 0) = Ws1Rng1.Offset(0, t + 2).Value

                        .List(.ListCount - 1, 1) = rngFindCorsiPersonale.Offset(0, t + 1).Value

                      End With

                    'End If '<==== e togliere apice iniziale anche qui per rendere effettiva la condizione

                  End If

                Else

                  If UCase(rngFindCorsiJobTitle.Offset(0, i).Value) = "M" Then

                    With .LB_CertificateExpired

                      .AddItem

                      .List(.ListCount - 1, 0) = Ws1Rng1.Offset(0, t + 2).Value

                      .List(.ListCount - 1, 1) = "To be done"

                      .List(.ListCount - 1, 2) = "!!!!!"

                    End With

                  End If

                End If

              End If

            Next t

        Next i

      End With

    End Sub

    '---

    Aggiungo il link al file aggiornato con questa modifica:

    File esempio #5 aggiornato

    La risposta è stata utile?

    0 commenti