caricare in una listbox i dati filtrati di un foglio

Question

Salve,

sono qui a chiedere come è possibile caricare in una listbox i dati filtrati di un foglio?

Grazie

Answer 1

Ciao Franco,

sono qui a chiedere come è possibile caricare in una listbox i dati filtrati di un foglio?

Per dimostrare un approccio, sviluppando la mia risposta alla domanda del tuo thread precedente, ho filtrato i dati sul Foglio1 e ho aggiunto una terza Listbox che ho caricato con i dati filtrati del Foglio1.

Nel codice seguente, i nuovi elementi sono evidenziati in grassetto:

Nel modulo standard (Module1):

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

Option Explicit

Public aRng As Range, bRng As Range, cRng As Range, ArrFilter() As Variant

Public aSH As Worksheet

'--------->>

Public Sub Button1_Click()

    UserForm1.Show vbModeless

End Sub

'--------->>

Public Sub SetRanges()

    Dim rArea As Range

    Dim LRow As Long

    Dim i As Long, j As Long, k As Long

    With aSH

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

        Set aRng = .Range("A1:D" & LRow)

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

        Set cRng = .AutoFilter.Range.SpecialCells(xlCellTypeVisible)

        For Each rArea In cRng.Areas

            For i = 1 To rArea.Rows.Count

                j = j + 1

                ReDim Preserve ArrFilter(1 To 4, 1 To j)

                For k = 1 To 4

                    ArrFilter(k, j) = rArea.Cells(i, k).Value

                Next k

            Next i

        Next rArea

    End With

End Sub

'--------->>

Public Function LastRow(SH As Worksheet, _

                        Optional Rng As Range)

    If Rng Is Nothing Then

        Set Rng = SH.Cells

    End If

    On Error Resume Next

    LastRow = Rng.Find(What:="*", _

                       after:=Rng.Cells(1), _

                       Lookat:=xlPart, _

                       LookIn:=xlFormulas, _

                       SearchOrder:=xlByRows, _

                       SearchDirection:=xlPrevious, _

                       MatchCase:=False).Row

    On Error GoTo 0

End Function

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

Ne modulo di codice della Userform:

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

Option Explicit

Dim iRow As Long

Const iButtons As Long = vbInformation

Const sTitle As String = "Riga Non Cancellata"

'--------->>

Private Sub UserForm_Initialize()

    Dim WB As Workbook

    Dim SH As Worksheet

    Const sColWidths As String = "40;50;40;35"

    Set WB = ThisWorkbook

    Set aSH = WB.Sheets("Foglio1")

    Call SetRanges

    With Me

        With .ListBox1

            .ColumnCount = 4

            .ColumnWidths = sColWidths

            .RowSource = bRng.Address(External:=True)

            .ColumnHeads = True

        End With

        With .ListBox2

            .ColumnCount = 4

            .ColumnWidths = sColWidths

            .List = aRng.Value

        End With

      With .ListBox3

.ColumnCount = 4

.ColumnWidths = sColWidths

.Column = ArrFilter

End With

        .cbListBox1.Caption = "Cancella Riga"

        .cbListBox2.Caption = "Cancella Riga"

        .cbChiudi.Caption = "CHIUDI!"

    End With

End Sub

'--------->>

Private Sub cbListBox1_Click()

    Dim sMsg As String

    iRow = Me.ListBox1.ListIndex

    Select Case iRow

    Case Is >= 0

        aRng.Rows(iRow + 2).Delete Shift:=xlUp

        Call SetRanges

        Call LoadListboxes

    Case -1

        sMsg = "Non hai selezionato una riga!"

    End Select

    If sMsg <> vbNullString Then

        Call MsgBox(Prompt:=sMsg, _

                    Buttons:=iButtons, _

                    Title:=sTitle)

    End If

End Sub

'--------->>

Private Sub cbListBox2_Click()

    Dim iRow As Long

    Dim sMsg As String

    iRow = Me.ListBox2.ListIndex

    Select Case iRow

    Case Is > 0

        bRng.Rows(iRow).Delete Shift:=xlUp

        Call LoadListboxes

    Case -1

        sMsg = "Non hai selezionato una riga!"

    Case 0

        sMsg = "Non si può cancellare le intestazioni!"

    End Select

    If sMsg <> vbNullString Then

        Call MsgBox(Prompt:=sMsg, _

                    Buttons:=iButtons, _

                    Title:=sTitle)

    End If

End Sub

'--------->>

Private Sub cbChiudi_Click()

    Unload Me

End Sub

'--------->>

Private Sub LoadListboxes()

    With Me

        .ListBox1.RowSource = bRng.Address(External:=True)

        .ListBox2.List = aRng.Value

        .ListBox3.Column = ArrFilter

    End With

End Sub

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

A proposito del tuo thread precedente, nota che ho utilizzato un terzo metodo per caricare la nuova Listbox; questo metodo sfrutta la proprietà Column della ListBox.

Potresti scaricare il mio file di esempio Franco#3_20150518.xlsm a: **http://1drv.ms/1Ba5okt**

===

Regards,

Norman