ordinare una listbox a più colonne

Question

Salve a tutti,

rientrato a lavoro e subito inizio a rompere con le mie domande.

Vorrei sapere se possibile come poter ordinare una listbox con 4 colonne in funzione della colonna selezionata.

Per cercare di far ciò, ho inserito 4 command button in testa alla listbox e vorrei che la lista venga ordinata in base al command button selezionato.

Posto una immagine per farvi capire meglio cosa intendo.

Anticipatamente ringrazio

Saluti

Peppe

Answer 1

Ciao Giuseppe,

se ho capito qual è il tuo problema io avrei creato una procedura che si limita, presi i dati che sono già presenti nella UserForm in base al suo caricamento iniziale, ad ordinarli.

Il problema che ho riscontrato è con le date che se inizialmente vengono caricate nel formato gg/mm/aaaa nella fase di ordinamento vengono visualizzate nel loro valore.

Io avevo trovato questa soluzione che però risulta essere lenta se il numero di voci da ordinare diventa "importante".

Questo il codice utilizzato da inserire nella userform (ad esclusione dell'evento Initialize che deve essere il tuo:

'----

Option Explicit

Option Compare Text

Const ColDate As Integer = 4

Private Sub UserForm_Initialize()

  'N.B. sostituire il codice di caricamento dati iniziale con il proprio codice

  With Me

    With .ListBox1

      .RowSource = "Elenco"

      .ColumnCount = Range("Elenco").Columns.Count

    End With

  End With

End Sub

Private Sub CommandButton1_Click()

  'N.B. utilizzare gli eventi Click in base al nome del proprio CommandButton

  Call OrdinaListBox(0)

End Sub

Private Sub CommandButton2_Click()

  'N.B. utilizzare gli eventi Click in base al nome del proprio CommandButton

  Call OrdinaListBox(1)

End Sub

Private Sub CommandButton3_Click()

  'N.B. utilizzare gli eventi Click in base al nome del proprio CommandButton

  Call OrdinaListBox(2)

End Sub

Private Sub CommandButton4_Click()

  'N.B. utilizzare gli eventi Click in base al nome del proprio CommandButton

  Call OrdinaListBox(3)

End Sub

Sub OrdinaListBox(Colonna As Integer)

  Dim arrLBi() As Variant, arrLBf() As Variant

  Dim i As Long, t As Integer

  With Me.ListBox1

    ReDim arrLBi(LBound(.List, 1) To UBound(.List, 1), LBound(.List, 2) To UBound(.List, 2))

    For i = LBound(.List, 1) To UBound(.List, 1)

      For t = LBound(.List, 2) To UBound(.List, 2)

        If t = ColDate - 1 Then

          If Not IsNumeric(.List(i, t)) Then

            arrLBi(i, t) = DateValue(.List(i, t))

          Else

            arrLBi(i, t) = .List(i, t)

          End If

        Else

          arrLBi(i, t) = .List(i, t)

        End If

      Next t

    Next i

    arrLBi = SortArrayEasy(arrLBi, Colonna)

    ReDim arrLBf(LBound(arrLBi, 1) To UBound(arrLBi, 1), LBound(arrLBi, 2) To UBound(arrLBi, 2))

    For i = LBound(arrLBi, 1) To UBound(arrLBi, 1)

      For t = LBound(arrLBi, 2) To UBound(arrLBi, 2)

        If t = ColDate - 1 Then

          arrLBf(i, t) = Format(arrLBi(i, t), "dd/mm/yyyy")

        Else

          arrLBf(i, t) = arrLBi(i, t)

        End If

      Next t

    Next i

    If .RowSource <> "" Then

      .RowSource = ""

    Else

      .Clear

    End If

    .List = arrLBf()

  End With

End Sub

Public Function SortArrayEasy(arrDati As Variant, col As Integer)

  Dim temp As Variant

  Dim i As Long, j As Long, t As Long

  ReDim temp(LBound(arrDati, 2) To UBound(arrDati, 2))

  For i = LBound(arrDati, 1) To UBound(arrDati, 1)

      For j = i + 1 To UBound(arrDati, 1)

          If arrDati(i, col) > arrDati(j, col) Then

            For t = LBound(temp, 1) To UBound(temp, 1)

              temp(t) = arrDati(i, t)

            Next t

            For t = LBound(temp, 1) To UBound(temp, 1)

              arrDati(i, t) = arrDati(j, t)

            Next t

            For t = LBound(temp, 1) To UBound(temp, 1)

              arrDati(j, t) = temp(t)

            Next t

          End If

      Next j

  Next i

  SortArrayEasy = arrDati

End Function

'-----

Edit:

Qui trovi un file di esempio

Esempio

Answer 2

Ciao Giuseppe,

In attesa della tua risposta, ho sostituito la routine UserForm_Initialize con la seguente versione:

'=========>>

Private Sub UserForm_Initialize()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim LRow As Long, iRows As Long

    Dim i As Long

    Const iPrimoAnno As Long = "2015"

    Const iUltimoAnno As Long = 2030

    Const dPrimaData As Date = #1/1/2015#

    Const dUltimaData As Date = #12/31/2030#

    Const sFoglio As String = "ElencoCertificati"

    Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)

    With SH

        LRow = LastRow(SH, .Columns("A:A"))

        Set RngList = .Range("A2:D" & LRow)

    End With

    iRows = iUltimoAnno - iPrimoAnno + 1

    With Me

        For i = 1 To 31

            .cbxStartDay.AddItem i

            .cbxEndDay.AddItem i

        Next i

        For i = 1 To 12

            .cbxStartMonth.AddItem i

            .cbxEndMonth.AddItem i

        Next i

        For i = iPrimoAnno To iUltimoAnno

            .cbxStartYear.AddItem i

            .cbxEndYear.AddItem i

        Next i

        With .cbxStartDay

            .Value = Day(dPrimaData)

            .ListRows = 31

        End With

        With .cbxStartMonth

            .Value = Month(dPrimaData)

            .ListRows = 12

        End With

        With .cbxStartYear

            .Value = Year(dPrimaData)

            .ListRows = iRows

        End With

        With .cbxEndDay

            .Value = Day(dUltimaData)

            .ListRows = 31

        End With

        With .cbxEndMonth

            .Value = Month(dUltimaData)

            .ListRows = 12

        End With

        With .cbxEndYear

            .Value = Year(dUltimaData)

            .ListRows = iRows

        End With

        .lbCertificates.List = RngList.Value

    End With

End Sub

'<<=========

===

Regards,

Norman

Answer 3

Ciao Norman,

ore piccole? :)

A me servirebbe un ordinamento di ciò che è visualizzato nella listbox. Senza nessun riferimento a date o fogli.

Come ho impostato io il programma, la listbox viene popolata tramite una ricerca in una matrice molto grande e mi riporta solo i dati se soddisfano determinati criteri.

Pertanto l'ordinamento mi serve solo in un secondo momento se voglio prenotare i refresh per tipologia di corso, per persona o per data di scadenza.

Ti allego la matrice ed i codici per farti capire come esce fuori quella list box.

Matrice generale:

RANK	SURNAME & NAME	BADGE Nr.	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 (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	RADAR REG A-II/1	ARPA REG A-II/1 - A-II/2	RADAR A.R.P.A. - BRIDGE TEAM WORK REG A-II/2	NAVIGATION USING ECDIS-Operational and Management levels (Tables A-II/1, A-II/2) (3)* (5*)	BASIC SAFETY FAMILIARISATION A-VI/1	SECURITY -RELATED FAMILIARISATION   REG A-VI/6	ECDIS TYPE SYSTEM FAMILIARISATION COURSE (5*)	SECURITY AWARNESS REG A-VI/6-1 (1*)	SEAFARERS WITH DESIGNATED SECURITY DUTIES A-VI/6-2 (1*)	SHIP SECURITY OFFICER REG A-VI/5 (1*)	USE OF LEADERSHIP AND MANAGERIAL SKILLS TRAINING COURSE (8*)	LEADERSHIP & MANAGERIAL SKILL (Tables A-II/1, A-II/2)	LEADERSHIP & MANAGERIAL SKILL (Tables A-III/1, A-III/2)	MARINE HIGH VOLTAGE SAFETY COURSE (ex:ABB -H851) (Op. level for III/1, Mng. level for III/2)	Well control OIM	MOU Stability (MOU type specific)  OIM (6*)	MOU Stability (MOU type specific)  BS (6*)	MOU Stability (MOU type specific)  BCO (6*)	H2S awareness course (6*)	HUET (Helicopter Underwater Escape Training) (4*)	Helicopter Landing Officer Initial Training (HLO) , then Helicopter Landing Officer Further Training (HLO FT)	HLO Helideck Emergency Response Team Leader (HERTL)	HDA Helideck Emergency Response Team Member (HERTM)	Helideck Assistant Initial training, then Helideck Assistant  Further training  (HDA FT) (2*)	Dangerous Goods By Air (CAA)  / Refresher	Helicopter Refueling  (HR) for vessels equipped with and using refueling system
Master	Castellano Giuseppe	8934	01/01/2017	No Exp.	01/01/2017	01/01/2017	01/01/2017	No Eexp.			No Exp.	04/02/2019	No Exp.	No Exp.	No Exp.							08/07/2019									26/01/2015	24/01/2019
Master	Langella Giuseppe	8134	06/11/2016	No Exp.	06/11/2016	06/11/2016		No Exp.	23/06/2005		No Exp.		No Exp.	No Exp.	No Exp.							11/06/2019									11/06/2019	16/10/2019
Chief Mate	Pitino Salvatore	8873	01/01/2017	01/01/2017	01/01/2017	01/01/2017	31/05/2015	01/01/2017			No Exp.	06/11/2018	No Exp.	No Exp.	No exp.							21/04/2020									09/12/2018	09/12/2017
Chief Mate	Sekulja Rajko	781135	10/03/2019	10/03/2019		10/03/2019	11/03/2019	11/03/2019	10/03/2019	03/03/2019		03/05/2018	No Exp.	No exp.	No Exp.	No Exp.						No Exp.									01/05/2017	01/05/2017
2nd Mate	Landini Andrea	8712	01/01/2017	01/01/2017	12/03/2008	01/01/2017		01/01/2017		No Exp.	No exp.		No Exp.	No Exp.	No Exp	15/01/2021						01/01/2017									29/09/2016	29/09/2016
2nd Mate	Persiano Raffaele	9040	01/01/2017	01/01/2017		01/01/2017	19/04/2014	01/01/2017		No Exp.	No Exp.	13/06/2017	No exp.	No Exp.	No Exp.	No exp.						18/01/2021									19/10/2017	10/12/2017
3rd Mate	Bazin Aleksandr	926956	13/05/2016		13/05/2016	13/05/2016	12/04/2018	11/04/2018			08/03/2016	17/07/2019	23/09/2018	23/09/2018	23/09/2018	12/09/2019				no.exp	No Exp.			11/07/2019							15/12/2016	15/12/2016
3rd Mate	Filipciuk Andrej	347021	12/08/2019			12/08/2019	17/02/2017	16/01/2020	08/08/2019	06/05/2020		21/01/2020	17/03/2020	17/03/2020		27/06/2019					No Exp.			08/08/2019							14/01/2018	17/03/2018
Bosun	Cibilic Josko	AG 265031	09/10/2019	09/10/2019	09/10/2019	09/10/2019															No Exp.										12/06/2016	17/06/2016
Bosun	Cieciora Roman	968637	24/09/2018	07/03/2017	06/03/2017	05/03/2017	no exp		14/12/2020																						28/06/2016	12/05/2017
Able seaman	Calkin Aleksej	922948	06/10/2020	06/10/2020	06/10/2020	06/10/2020	17/06/2016		25/06/2025												no.exp										19/01/2020	01/02/2020
Able seaman	Hutabarat Antonius Swandi					04/03/2019	09/04/2019		no exp												no exp											04/01/2017
Able seaman	Kavaliuskas Kestutis	906974	06/10/2020	06/10/2020	06/10/2020	06/10/2020	19/08/2016	15/10/2020	02/02/2020																						24/05/2017	24/05/2017
Able seaman	Rihi Simson Christian		11/08/2019	11/08/2019	11/08/2019	11/08/2019		No Exp.
Chief Engineer	Anichini Federico	8634	01/01/2017	01/01/2017	01/01/2017	01/01/2017		01/01/2017																							20/11/2019	20/11/2019
Chief Engineer	Rivano Victor	8829	31/12/2016	31/12/2016		31/12/2016		31/12/2016		No Exp.																					30/08/2016	30/08/2016
1st Engineer	Morgera Giuseppe	946882	01/01/2017	01/01/2017		01/01/2017	01/08/2015	01/01/2017		01/01/2017											No Exp.										14/04/2019	14/04/2019
1st Engineer	Solari Fabio	8673	01/01/2017	01/01/2017	01/01/2017	01/01/2017		01/01/2017												No Exp.											11/09/2017	28/11/2018
2nd Engineer	Bondar Gennadyi	926821	12/05/2019	12/05/2019		12/05/2019	12/05/2019	12/05/2019		12/05/2019											11/09/2020				12/05/2019						03/04/2015	26/03/2017
2nd Engineer	Favatella Antonio	8887	01/01/2017	01/01/2017		01/01/2017	28/08/2014	01/01/2017		No Exp.																					12/12/2017	28/01/2018
2nd Engineer	Lucia Luigi	9001	18/12/2016	18/12/2016		18/12/2016	18/12/2016	18/12/2016		No exp.											No Exp.										09/10/2016	09/10/2016
2nd Engineer	Senyak Yuriy	908738	22/01/2021			22/01/2021	22/01/2021	22/01/2021		22/01/2021											12/06/2020				12/06/2020						14/03/2015	13/03/2017
Motorman	Karpinski Hubert	989141	10/05/2020			no exp	11/05/2020	11/05/2020		no exp										no exp	no exp										05/09/2017	05/09/2017
Motorman	Katalup Viktor	921737	12/03/2018	12/03/2018		12/03/2018	12/03/2018																								05/03/2018	26/10/2019
Motorman	Nikisin Igor	913345																													08/07/2018	06/06/2018
Motorman	Szczytynski Blazej	928866																													13/04/2019	19/02/2017
Radio Operator	Azis Abdul											27/11/2020																				22/01/2019
Radio Operator	Melchior Essen Effendi											15/06/2020																				09/05/2017
Radio Operator	Teguh Rinaldi											19/10/2017																				01/08/2016
Radio Operator	Wibisono Ary											02/09/2020																				13/09/2016

Questo è il codice sotto al commandbutton "Search"

Dim uno As String

Dim due As String

Dim tre As String

Dim contatore As Integer

Dim CL As Object

Dim start As Date

Dim fine As Date

Dim messaggio As String

If giorno.Value + mese.Value + anno.Value + giornofine.Value + mesefine.Value + annofine.Value = "" Then

messaggio = MsgBox("The filters are empty, would you like to search without filters?" _

& Chr(13) & Chr(13) & "If you click yes, the search wiil be done for all certificates expired and expiring in the next 3 month", vbYesNo, "Information")

If messaggio = vbYes Then

Me.ListBox1.Clear

cv = 0

contatore = 1

Do

contatore = contatore + 1

uno = contatore

due = "A" + uno

tre = "B" + uno

For x = 4 To 50

y = Range(due).Columns(x).Address

For Each CL In Range(y)

If CL.Value = "" Then

cv = cv + 1

ElseIf CL >= Date - 10000 And CL <= Date + 90 Then

B = ListBox1.ListCount

n = CL.Row - 1

ListBox1.AddItem Range(due)

ListBox1.List(B, 1) = Range(tre)

ListBox1.List(B, 2) = CL.Offset(-n, 0)

ListBox1.List(B, 3) = CL.Text

End If

Exit For

Next

Next

Loop Until Range(due) = ""

Exit Sub

ElseIf messaggio = vbNo Then

Exit Sub

End If

End If

If giorno = "" Or mese = "" Or anno = "" _

Or giornofine = "" Or mesefine = "" Or annofine = "" Then

messaggio = MsgBox("There is a mistake in the filters. " _

& Chr(13) & Chr(13) & "Please insert all paramiters to start the search.", vbInformation, "Information")

Exit Sub

Else

Me.ListBox1.Clear

cv = 0

contatore = 1

start = giorno.Value & "/" & mese.Value & "/" & anno.Value

fine = giornofine.Value & "/" & mesefine.Value & "/" & annofine.Value

Do

contatore = contatore + 1

uno = contatore

due = "A" + uno

tre = "B" + uno

For x = 4 To 50

y = Range(due).Columns(x).Address

For Each CL In Range(y)

If CL.Value = "" Then

cv = cv + 1

ElseIf CL >= start And CL <= fine Then

B = ListBox1.ListCount

n = CL.Row - 1

ListBox1.AddItem Range(due)

ListBox1.List(B, 1) = Range(tre)

ListBox1.List(B, 2) = CL.Offset(-n, 0)

ListBox1.List(B, 3) = CL.Text

End If

Exit For

Next

Next

Loop Until Range(due) = ""

End If

Come vedi dal codice ho due possibilità:

1. se non inserisco nessun range date mi trova nella matrice tutti i certificati scaduti ed in scadenza nei prossimi tre mesi.
2. inserisco un range date e trova tutti i certificati che scadranno in quel range.

Adesso vorrei ordinare solo ciò che vedo nella listbox per le 4 colonne.

Spero di essere stato più chiaro anche se il codice sicuramente vi farà sbellicare :)

Ciao e grazie ancora

Peppe

Answer 4

Ciao Giuseppe,

Quando vedo questi codici mi rendo conto sempre di più che da solo non ci sarei mai arrivato.

L'ho appena scaricato perchè con 6 ore di fuso orario mi sono appena svegliato.

Comunque senza entrare ancora nel codice ho capito, dalla tua frase, che fai riferimento ai combobox.

Purtroppo ho già visto dal tuo file di esempio che non fa esattamente ciò che serviva a me. Per meglio dire lo fa ed anche benissimo ma non dovrei lavorare su nessun range di date. In quella listbox sono già presenti i certificati in scadenza dalla data del computer a +90 giorni e tutti quelli già scaduti. Se faccio riferimento a delle date precise rischio di omettere dei certificati scaduti ma che non entrano nel range date selezionato.

Per chiarire meglio la funzionalità dei combobox vi dico che se non inserisco nessuna data e clicco su search, la routine troverà tutti i certificati di ciu sopra. Se invece inserisco un range date troverà tutti i certificati per quel range ed addirittura se inserisco per esempio dal 01/01/2016 al 31/12/2016 mi darà tutti i certificati in scadenza nell'anno 2016 in modo da programmare i refresh.

Pertanto dato le possibili varianti, avrei bisogno di un ordine sono su ciò che popola la listbox e non in funzione delle combobox.

Come avevi già supposto, ho già popolato il combobox nel suguente modo.

Poresti suggerirmi un modo migliore? Io ho fatto così:

Private Sub UserForm_Initialize()

Dim giorno As Integer

Dim mese As Integer

Dim anno As Integer

giorno = 1

mese = 1

anno = 2016

For giorno = giorno To 31

Me.giorno.AddItem (giorno)

Me.giornofine.AddItem (giorno)

Next giorno

For mese = mese To 12

Me.mese.AddItem (mese)

Me.mesefine.AddItem (mese)

Next mese

For anno = anno To 2030

Me.anno.AddItem (anno)

Me.annofine.AddItem (anno)

Next anno

End Sub

Non sono sicuro di aver capito il tuo problema ma ho adattato il tuo codice per riempire i controlli ComboBox. Come scritto, l'ntervallo è quella compreso dentro le date assegnate alle due costante dPrimaData e dUltimaData.

Per assicurarsi che nessun dato fosse escluso, dovrebbe essere sufficiente utilizzare il massimo intervallo tra le date, ovvero l'intervallo assegnato all'avvio della Userform, dPrimaData a dUltimaData.

Credevo che la tua intenzione fosse di filtrare i dati compresi tra le date stabilite dai controlli ComboBox e ordinarli  utilizzando il  CommandButton premuto come criterio di ordinamento. Per rendermi consapevole del problema, ti chiederei gentilmente di fornirmi un esempio specifico con i dati caricati nel controllo ListBox.  

Il codice della routine UserForm_Initialize è diventato:

'=========>>

Private Sub UserForm_Initialize()

    Dim WB As Workbook

    Dim SH As Worksheet

    Dim LRow As Long

    Dim i As Long

    Const iPrimoAnno As Long = "2015"

    Const iUltimoAnno As Long = 2030

    Const dPrimaData As Date = #1/1/2015#

    Const dUltimaData As Date = #12/31/2030#

    Const sFoglio As String = "ElencoCertificati"

    Set WB = ThisWorkbook

    Set SH = WB.Sheets(sFoglio)

    With SH

        LRow = LastRow(SH, .Columns("A:A"))

        Set RngList = .Range("A2:D" & LRow)

    End With

    With Me

        For i = 1 To 31

            .cbxStartDay.AddItem i

            .cbxEndDay.AddItem i

        Next i

        For i = 1 To 12

            .cbxStartMonth.AddItem i

            .cbxEndMonth.AddItem i

        Next i

        For i = iPrimoAnno To iUltimoAnno

            .cbxStartYear.AddItem i

            .cbxEndYear.AddItem i

        Next i

        .cbxStartDay.Value = Day(dPrimaData)

        .cbxStartMonth.Value = Month(dPrimaData)

        .cbxStartYear.Value = Year(dPrimaData)

        .cbxEndDay.Value = Day(dUltimaData)

        .cbxEndMonth.Value = Month(dUltimaData)

        .cbxEndYear.Value = Year(dUltimaData)

        .lbCertificates.List = RngList.Value

    End With

End Sub

'<<=========

Indipendentemente da quale sia  il problema, sono sicuro che sarà facilmente possibile adattare il mio codice per soddisfare le tu esigenze.

Nel frattempo, ho aggionato il file Giuseppe20160717.xlsm a:

https://www.dropbox.com/s/f8n6fszvzcirxga/Giuseppe20160617.xlsm?dl=0

===

Regards,

Norman

Answer 5

Ciao Norman e ciao tutti,

Quando vedo questi codici mi rendo conto sempre di più che da solo non ci sarei mai arrivato.

L'ho appena scaricato perchè con 6 ore di fuso orario mi sono appena svegliato.

Comunque senza entrare ancora nel codice ho capito, dalla tua frase, che fai riferimento ai combobox.

Purtroppo ho già visto dal tuo file di esempio che non fa esattamente ciò che serviva a me. Per meglio dire lo fa ed anche benissimo ma non dovrei lavorare su nessun range di date. In quella listbox sono già presenti i certificati in scadenza dalla data del computer a +90 giorni e tutti quelli già scaduti. Se faccio riferimento a delle date precise rischio di omettere dei certificati scaduti ma che non entrano nel range date selezionato.

Per chiarire meglio la funzionalità dei combobox vi dico che se non inserisco nessuna data e clicco su search, la routine troverà tutti i certificati di ciu sopra. Se invece inserisco un range date troverà tutti i certificati per quel range ed addirittura se inserisco per esempio dal 01/01/2016 al 31/12/2016 mi darà tutti i certificati in scadenza nell'anno 2016 in modo da programmare i refresh.

Pertanto dato le possibili varianti, avrei bisogno di un ordine sono su ciò che popola la listbox e non in funzione delle combobox.

Come avevi già supposto, ho già popolato il combobox nel suguente modo.

Poresti suggerirmi un modo migliore? Io ho fatto così:

Private Sub UserForm_Initialize()

Dim giorno As Integer

Dim mese As Integer

Dim anno As Integer

giorno = 1

mese = 1

anno = 2016

For giorno = giorno To 31

Me.giorno.AddItem (giorno)

Me.giornofine.AddItem (giorno)

Next giorno

For mese = mese To 12

Me.mese.AddItem (mese)

Me.mesefine.AddItem (mese)

Next mese

For anno = anno To 2030

Me.anno.AddItem (anno)

Me.annofine.AddItem (anno)

Next anno

End Sub

Grazie ancora

Peppe