Autres Listbox-transfère la recherche dans une ListBox vers une feuille de calcul

Sub essai()
Set f = Sheets("Feuil1")
Tbl = Range("F1:F9")
With f
.Range("A3").Resize(UBound(Tbl), 1).Value = Tbl
End With
End Sub

With UserForm27.ListBox1
ColVisu = Array(0, 1, 2, 4)
End With

With UserForm27.ListBox1
V = .List
Dim result As Variant
Dim Tbl()
For i = 1 To UBound(V)
' If InStr(1, V(i, 9), Trim(s), vbTextCompare) Then
found = True
n = n + 1: ReDim Preserve Tbl(1 To UBound(V, 2), 1 To n)
c = 0
For Each k In ColVisu
c = c + 1: Tbl(c, n) = V(i, k)
Next k
' End If
Next
End With

With f
.Range("A3").Resize(UBound(Tbl) + 1, 1).Value = Application.Transpose(Tbl)
End With

ListBox1.ListCount
ListBox1.ColumnCount
ListBox1.list(1,1)

.Resize(ubound(tb,2), ubound(tb,1)) 'nombre de lignes du tb ubound(tb,1)

Dim i As Long, j As Integer
    Dim ColVisu As Variant
    Dim rs As Object ' Objet Recordset
    ColVisu = Array(0, 1, 2, 4) ' Colonnes à extraire

    ' Créer un objet Recordset
    Set rs = CreateObject("ADODB.Recordset")

    ' Définir les colonnes du Recordset
    With rs
    For j = 0 To UBound(ColVisu)
         .Fields.Append "Colonne" & j, 200, 255 ' Type texte, taille 255
    Next
    .Open
    End With

    ' Parcourir le ListBox et ajouter les lignes qui contiennent S dans la colonne 9
    With Me.ListBox1
        For i = 0 To .ListCount - 1
            If InStr(1, .List(i, 8), Trim(S), vbTextCompare) > 0 Then
                rs.AddNew
                For j = 0 To UBound(ColVisu)
                   rs(j) = .List(i, ColVisu(j))
                Next
                rs.movefirst
            End If
        Next i
    End With

 
If Not rs.EOF Then Sheets("Feuil2").Range("A3").CopyFromRecordset rs
    ' Libérer l'objet Recordset
    Set rs = Nothing

Private Sub CommandButton1_Click()

'Set ff = ThisWorkbook.Worksheets("filtra")

With UserForm27.ListBox1

ColVisu = Array(1, 2, 6)

End With



With UserForm27.ListBox1

v = .List

Dim result As Variant

Dim Tbl()

For i = 0 To UBound(v)

'v(i, 1) = Format(v(i, 1), "dd/mm/yyyy")

'v(i, 1) = Format(CDate(v(i, 1)), "dd/mm/yyyy")

found = True

n = n + 1: ReDim Preserve Tbl(1 To UBound(v, 2), 1 To n)

c = 0

For Each k In ColVisu

v(i, 1) = CDate(v(i, 1))

c = c + 1: Tbl(c, n) = v(i, k)

Next k

Next

End With



With f

'.Range("A3").Resize(UBound(Tbl) + 1, 3).Value = Application.Transpose(Tbl)

Range("K2").Resize(UBound(Tbl, 2), UBound(Tbl, 1)) = Application.Transpose(Tbl)

End With





End Sub



Private Sub CommandButton2_Click()

Unload UserForm27

End Sub



Private Sub UserForm_Initialize()

Dim arr

Set f = ThisWorkbook.Worksheets("movimenti")

f.Columns("B:B").NumberFormat = "dd/mm/yyyy"

With f

arr = f.Range("A2:G" & f.[A65000].End(xlUp).Row).Value

End With



With UserForm27.ListBox1

.List = arr

.ColumnCount = 7

.ColumnWidths = "30; 50; 60; 150; 60; 60; 70"

End With

Private Sub CommandButton1_Click()
Dim result As Variant
Dim Tbl()

'Set ff = ThisWorkbook.Worksheets("filtra")
Set f = ThisWorkbook.Worksheets("movimenti")

With UserForm27.ListBox1
ColVisu = Array(1, 2, 6)
End With

With UserForm27.ListBox1
v = .List
For i = 0 To UBound(v)
n = n + 1: ReDim Preserve Tbl(1 To UBound(v, 2), 1 To n)
c = 0
For Each k In ColVisu
If IsDate(v(i, 1)) Then v(i, 1) = Format(v(i, 1), "mm/dd/yyyy")
c = c + 1: Tbl(c, n) = v(i, k)
Next k
Next
End With
With f

'.Range("A3").Resize(UBound(Tbl) + 1, 3).Value = Application.Transpose(Tbl)
f.Range("K2").Resize(UBound(Tbl, 2), UBound(Tbl, 1)) = Application.Transpose(Tbl)

End With

End Sub

Private Sub CommandButton1_Click()
Dim i As Long, j As Integer
    Dim S As String
    Dim ColVisu As Variant, Forma, TP

    Dim rs As Object ' Objet Recordset:TP
  ColVisu = Array(1, 2, 6): Forma = Array("YYYY-MM-DD", "@", "#,##0.00"): TP = Array(7, 200, 5)

    ' Créer un objet Recordset
    Set rs = CreateObject("ADODB.Recordset")

    ' Définir les colonnes du Recordset
    With rs
    For j = 0 To UBound(ColVisu)
         .Fields.Append "Colonne" & j, TP(j), 255
    Next
    .Open
    End With

    ' Parcourir le ListBox et ajouter les lignes qui contiennent "e" dans la colonne 9
    With Me.ListBox1
        For i = 0 To .ListCount - 1
           ' If InStr(1, .List(i, 9), Trim(S), vbTextCompare) > 0 Then
                rs.AddNew
                For j = 0 To UBound(ColVisu)
                   rs(j) = Format(.List(i, ColVisu(j)), Forma(j))
                Next
                rs.movefirst
           ' End If
        Next i
    End With

  
If Not rs.EOF Then Range("K2").CopyFromRecordset rs
    ' Libérer l'objet Recordset
    Set rs = Nothing
End Sub