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

 

[sylvanu]

Bonsoir,
Votre ligne de code n'apparait pas dans votre code. Difficile de comprendre.
Pouvez vous fournir un fichier test, ce sera plus compréhensible.

J"ai testé ça, et ça ne met aucune erreur :

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

Peut être que votre erreur n'est pas liée à votre ligne erronée mais une ligne avant.

 

[francescofrancesco]

Bonsoir,
Votre ligne de code n'apparait pas dans votre code. Difficile de comprendre.
Pouvez vous fournir un fichier test, ce sera plus compréhensible.

J"ai testé ça, et ça ne met aucune erreur :

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

Peut être que votre erreur n'est pas liée à votre ligne erronée mais une ligne avant.

 

[francescofrancesco]

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

 

[francescofrancesco]

Bonjour,
Voici le code complet.
Il s'agit de transférer uniquement certaines colonnes de la liste déroulante vers la feuille de calcul.

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

 

[sylvanu]

Bonjour,
Toujours pas de fichier test ?
L'erreur peut avoir de multiples causes, et le code seul ne permet aucun test..
Peut être qu'un contributeur plus inspiré aura sa boule de cristal opérationnel. ☺

 

[dysorthographie]

bonjour,
personnellement je vois pas l'intérêt de passer par le tableau V() alors que la source de ce tableau est une listebox.

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

.Resize(lignes, colonnes)
si tu fais un transpose il faut inverser ubound(tb,1) et ubound(tb,2 ) dans le

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

 

[francescofrancesco]

Bonjour,
Voici le code complet.
Il s'agit de transférer uniquement certaines colonnes de la liste déroulante vers la feuille de calcul.

Bonjour,
Toujours pas de fichier test ?
L'erreur peut avoir de multiples causes, et le code seul ne permet aucun test..
Peut être qu'un contributeur plus inspiré aura sa boule de cristal opérationnel. ☺

 

[dysorthographie]

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

 

[francescofrancesco]

Je ne peux pas joindre le fichier, même s'il est petit.

Message : Fichier trop volumineux.

 

[francescofrancesco]

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

 

[dysorthographie]

si tu nous fournir un fichier avec les 10 première ligne ça le fait.

remplaces UserForm27.ListBox1
par Me.ListBox1

 

[francescofrancesco]

Le seul problème concerne la colonne des dates.
Les dates sont inversées.
Voyons si je peux trouver une solution.