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

[francescofrancesco]

Bonne soirée,
J'ai une erreur sur cette ligne:
With f
.Range("A3").Resize(UBound(Tbl) + 1, 1).Value = Application.Transpose(Tbl)
End with
Mercì .
Excel 2003

                        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

 

[francescofrancesco]

Je souhaiterais une explication pour cette partie de la ligne. S'il y avait quatre colonnes, alors quatre.
ColVisu = Array(1, 2, 6): Forma = Array("YYYY-MM-DD", "@", "#,###.00"): TP = Array(7, 200, 5)
Array("YYYY-MM-DD", "@", "#,###.00") <<<<<<Définir le format
TP = Array(7, 200, 5) <<<<<< valori
S'il y avait quatre colonnes, alors quatre.

 

[dysorthographie]

bonsoir,
Vue d'ensemble
Ce code extrait certaines colonnes d'un ListBox, les formate, et les colle dans Excel à partir de la cellule K2.
Explication ligne par ligne
1. Déclaration des variables
Dim i As Long, j As Integer
Dim S As String
Dim ColVisu As Variant, Forma, TP
Dim rs As Object
i : compteur pour parcourir les lignes du ListBox
j : compteur pour parcourir les colonnes sélectionnées
S : chaîne de caractères (non utilisée dans le code actuel)
ColVisu, Forma, TP : tableaux de type Variant
rs : objet Recordset ADO pour stocker temporairement les données
2. Configuration des paramètres
ColVisu = Array(1, 2, 6)
Forma = Array("YYYY-MM-DD", "@", "#,##0.00")
TP = Array(7, 200, 5)
ColVisu : indices des colonnes à extraire du ListBox (colonnes 1, 2 et 6)
Forma : formats à appliquer à chaque colonne
"YYYY-MM-DD" → format date pour la colonne 1
"@" → format texte pour la colonne 2
"#,##0.00" → format numérique avec 2 décimales pour la colonne 6
TP : types de données ADO
7 = adDate (date)
200 = adVarChar (texte)
5 = adDouble (nombre décimal)
3. Création et configuration du Recordset
Set rs = CreateObject("ADODB.Recordset")

With rs
For j = 0 To UBound(ColVisu)
.Fields.Append "Colonne" & j, TP(j), 255
Next
.Open
End With
Cette section crée un Recordset vide et définit sa structure avec 3 colonnes (Colonne0, Colonne1, Colonne2), chacune avec son type de données approprié. La taille maximale est fixée à 255 caractères.
4. Remplissage du Recordset
With Me.ListBox1
For i = 0 To .ListCount - 1
rs.AddNew
For j = 0 To UBound(ColVisu)
rs(j) = Format(.List(i, ColVisu(j)), Forma(j))
Next
rs.movefirst
Next i
End With
Cette boucle parcourt toutes les lignes du ListBox et :
Crée un nouveau enregistrement (rs.AddNew)
Remplit les 3 colonnes avec les données formatées
Note : Les lignes commentées montrent qu'à l'origine, il y avait un filtre sur la colonne 9.
5. Copie vers Excel
If Not rs.EOF Then Range("K2").CopyFromRecordset rs
Si le Recordset contient des données, elles sont collées dans Excel à partir de la cellule K2.
6. Nettoyage
Set rs = Nothing
Libère la mémoire occupée par l'objet Recordset.
Points à améliorer
Supprimer rs.movefirst de la boucle (ligne inutile et coûteuse en performance)
Ajouter rs.movefirst avant la copie si nécessaire :
If Not rs.EOF Then
rs.MoveFirst
Range("K2").CopyFromRecordset rs
End If
La variable S n'est pas utilisée et peut être supprimée

 

[francescofrancesco]

"#,##0.00" → format numérique avec 2 décimales pour la colonne 6
Ici, il ne donne pas le résultat attendu.

 

[dysorthographie]

Private Sub CommandButton100_Click()

Dim i As Long, j As Integer
    Dim S As String
    Dim ColVisu As Variant, Forma, TP, Taille

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

    ' 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
              
           ' End If
        Next i
    End With
Dim varArray() As Variant
With rs

    If Not .EOF Then
         .MoveFirst
        Range("K2").CopyFromRecordset rs
        .MoveFirst
    
        ListBox2.ColumnCount = .Fields.Count
         ListBox2.BoundColumn = .Fields.Count
         ListBox2.ColumnWidths = "60;80;80"
        ListBox2.List = Application.Transpose(.getrows)
    End If
End With




rs.MoveLast
n = rs.RecordCount
rs.MoveFirst
varArray() = rs.getrows(n)
With ListBox3
For i = 0 To n - 1
'ListBox3.AddItem varArray(0, i) & ";" & varArray(1, i)
.AddItem varArray(0, i)
.List(.ListCount - 1, 1) = varArray(1, i)
.List(.ListCount - 1, 2) = varArray(2, i)
Next
End With

Set rs = Nothing


End Sub