Microsoft 365 Listbox case à cocher transfert sur feuille

sylvanu

XLDnaute Barbatruc

Supporter XLD

• 7 Avril 2021

• #2

Bonjour Scorpio,
Un essai en PJ avec quelques modifications dans CommandButton1_Click :
- remplacez Clear par Clearcontents conserve les formats utilisés
- précisez dans quel userform on travaille, en l'occurrence ListBox1
- je ne comprends pas l'utilité de la mise en forme sur la colonne 7
En espérant ne pas être à coté de la plaque.

 

Pièces jointes

• GroupeOptionsMultiples.xlsm

  29.9 KB · Affichages: 8

Vote positif 0 Vote négatif

S

Scorpio

XLDnaute Impliqué

• 7 Avril 2021

• #3

Bonjour Sylvanu,
Super boulot, un grand merci.
Est-ce qu'il serais possible de faire encore une modif ??
En fait, je voudrais faire la recherche dans la colonne "A"
Merci Sylvanu, à ++++
Scorpio

 

Vote positif 0 Vote négatif

sylvanu

XLDnaute Barbatruc

Supporter XLD

• 7 Avril 2021

• #4

Re,
Un essai.

 

Pièces jointes

• GroupeOptionsMultiples (2).xlsm

  32.5 KB · Affichages: 11

Vote positif 0 Vote négatif

S

Scorpio

XLDnaute Impliqué

• 7 Avril 2021

• #5

Re,
A oui, c'est super, merci beaucoup de votre aide.
Je regarde et vous redis, a++++
Scorpio

 

Vote positif 0 Vote négatif

S

Scorpio

XLDnaute Impliqué

• 7 Avril 2021

• #6

Re,
Dans la classeur du fil #4, le transfert est très rapide
J'ai copié le formulaire dans un autre classeur mais avec beaucoup plus de donnée, (données Perso, sensible)
Et là, c'est beaucoup plus lent, ca fonctionne mais au ralentis, pourquoi, ???

 

Vote positif 0 Vote négatif

sylvanu

XLDnaute Barbatruc

Supporter XLD

• 7 Avril 2021

• #7

Re,
Il peux y avoir beaucoup de raisons.
Testez cette PJ, il y a 5000 données dans la BD.
Si on transfère tout, sur mon PC, cela prend 2.3s. Ce qui me semble raisonnable pour une telle quantité de données.

 

Pièces jointes

• GroupeOptionsMultiples (3).xlsm

  384.3 KB · Affichages: 3

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 7 Avril 2021

• #8

Bonjour Scorpio, sylvanu,

Scorpio à dit:

J'ai copié le formulaire dans un autre classeur mais avec beaucoup plus de donnée, (données Perso, sensible)
Et là, c'est beaucoup plus lent, ca fonctionne mais au ralentis, pourquoi, ???

Cliquez pour agrandir...

La macro de transfert est lente parce qu'elle remplit les cellules une par une :

VB:

            For i = 0 To ListBox1.ListCount - 1
                For j = 0 To ListBox1.ColumnCount - 2
                    .Cells(2 + i, j + 1) = ListBox1.List(i, j)    'boucle de transfert
                Next j
            Next i

Il faut bien sûr les remplir en passant par un tableau VBA, c'est classique.

Nota : 5000 données c'est peanuts...

A+

 

Vote positif 0 Vote négatif

S

Scorpio

XLDnaute Impliqué

• 7 Avril 2021

• #9

Re Sylvanu
Alors j'ai essayé, mais le transfert est très lent, et comme le dit si bien job75,
Chaque lignes est copiée l'une après l'autre, = très très lent

 

Vote positif 0 Vote négatif

sylvanu

XLDnaute Barbatruc

Supporter XLD

• 7 Avril 2021

• #10

Bonjour Job,
Cette approche était dans la version initiale, donc inchangée pour le problème de ce fil qui ne concernait que "Listbox case à cocher transfert sur feuille"

En PJ une autre approche en passant par un array, on passe de 2.3s à 0.15s.

 

Pièces jointes

• GroupeOptionsMultiples (4).xlsm

  365 KB · Affichages: 19

Vote positif 0 Vote négatif

S

Scorpio

XLDnaute Impliqué

• 7 Avril 2021

• #11

Re Sylvanu, et job75
Je pense cette fois c'est bon, en faisant mes essais, c'est bien plus rapide.
Super grand merci de votre précieuse aide, et à une autre occasion.
Merci beaucoup beaucoup
Scorpio.

 

Vote positif 0 Vote négatif

S

Scorpio

XLDnaute Impliqué

• 7 Avril 2021

• #12

Salut job75
Merci Job75, effectivement, c'est du rapidos, et sans accro.
Merci beaucoup du coup de main, j'essaie tous cela tranquillement, le temp de digérer les codes.
A++++
Scorpio

 

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 7 Avril 2021

• #13

Je refais mon message.

En fait ListBox1.List est déjà un tableau VBA donc utilisez :

VB:

Private Sub CommandButton1_Click()
    Dim T0, n&
    T0 = Timer
    n = ListBox1.ListCount
    With Sheets("Regroupe").[A2]
        If n Then .Resize(n, 6) = ListBox1.List
        .Offset(n).Resize(Rows.Count - n - .Row + 1, 6).ClearContents 'RAZ en dessous
    End With
    TempsTransfert = "Temps de transfert : " & Round(1000 * (Timer - T0), 0) & "ms"
    MsgBox "Transfert terminé!", vbOKOnly + vbInformation, "TRANSFERT"
End Sub

 

Vote positif 0 Vote négatif