XL 2016 Méthode rapide pour mettre cellules dans variable tableau

  • Initiateur de la discussion Compte Supprimé 979
  • Date de début
C

Compte Supprimé 979

Guest
Bonjour à toutes et à tous,

Qui pourrait me donner une méthode rapide pour le code pour mettre des cellules dans une variable tableau

Situation :
- J'ai un classeur de DA (Demande d'Achats) qui contient 12.500 lignes
- Sur la feuille "DA" on saisi en colonne H les quantités souhaitées de matériel

Objectif :
- Mettre plusieurs cellule de la ligne contenant une Qt dans une variable tableau

Sachant que le fichier contient plus de 12.000 lignes
- je vais comptabiliser le nombre de lignes dont Qt <> 0

Je pensais faire une boucle et mémoriser chaque ligne dont Qt <>0 et sortir de la boucle si NbLignesQt est atteint
Mais n'y a t'il pas une solution plus rapide ?

Un fichier test qui va bien pour quelques lignes... mais pour plus de 10.000 🥴

Par avance merci de votre aide
 

Pièces jointes

  • Classeur DA.xlsm
    32.1 KB · Affichages: 24
Solution
C
Salut mapomme, tous,

J'ai considéré que la question était (je cite) :
Donc, logiquement, on ne mesure pas le transfert sur la feuille ;).
C'est pourquoi la durée est comptée quand r est rempli.
nota : pour 20 000 lignes de données, si on mesure après le transfert sur la feuille Résultat, on trouve entre 0,016 et 0,032 s.
Cliquez pour agrandir...

Tu penses bien que je ne garde pas ma variable tableau comme ça... au chaud 😜
Je colle mon tableau sur une feuille, il faut donc bien prendre en compte ce délais

Mais c'est tout bon, vous m'avez donné toutes les codes possible et inimaginables 😁

Comme je ne peux les marquer tous comme solution, j'ai marqué ce message 🤣 👍
Trier par date Trier par votes
Cousinhub

Cousinhub

XLDnaute Barbatruc
Inactif
Re-,
J'oubliais,
J'avais également testé avec un filtre élaboré.. 0.055
VB: 
Sub Macro2()
T = Timer
Dim Plg As Range
With Sheets("DA")
    Set Plg = .Range("A4:Q" & .Cells(Rows.Count, "F").End(xlUp).Row)
    .Range("S5").FormulaR1C1 = "=RC[-11]<>0"
End With
With Sheets("Résultat")
    .Range("K1").Resize(, 4).Value = Sheets("DA").Range("E4").Resize(, 4).Value
    Plg.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:= _
        Sheets("DA").Range("S4:S5"), CopyToRange:=.Range("K1").Resize(, 4), Unique:=False
End With
Sheets("DA").Range("S4:S5").Clear
MsgBox Timer - T
End Sub

Mais, bon trop de choix pourrait nuire au choix... :)
 
Vote positif 0 Vote négatif
C

Compte Supprimé 979

Guest
Bonsoir à tous et un GRAND merci 👍

Vous me sortez d'un sacré calvaire.... j'ai les neurones qui chauffaient dur...

J'ai effectivement l'embarras du choix 😂 vous êtes des cadors les mecs 😉

Je ne sais pas si je dois vous dire quel code je prends 😁
ils sont tous au TOP et ça va m'éviter m'arracher les derniers cheveux que j'ai.

BRAVO 👏
 
Vote positif 0 Vote négatif
Cousinhub

Cousinhub

XLDnaute Barbatruc
Inactif
laurent950 à dit:
Bonsoir,

Sans Boucle :

VB: 
Option Explicit
Sub Test2()
  Dim Sht As Worksheet
      Set Sht = ThisWorkbook.Worksheets("DA") ' ..................... Feuille DA
  Dim dLig As Long
      dLig = Sht.Range("F" & Rows.Count).End(xlUp).Row ' ............ Derniére ligne non vide
  Dim Filtre As Range
      Set Filtre = Sht.Range(Sht.Cells(4, 5), Sht.Cells(dLig, 8)) ' .. Zone de séléction pour Filtre
          Filtre.AutoFilter Field:=4, Criteria1:="<>" ' .............. Filtre sur Place
  Dim Plage As Range
      Set Plage = Filtre.SpecialCells(xlCellTypeVisible) ' .......... Cellule visible de la zone de Filtre
          Plage.Copy ' .............................................. Copies des cellules non vides
          Sheets("Résultat").Cells(1, 1).PasteSpecial _
                                        Paste:=xlPasteValues, _
                                        Operation:=xlNone, _
                                        SkipBlanks:=False, _
                                        Transpose:=False ' ......... Collage des valeurs sur la Feuille Résultat
          Application.CutCopyMode = False ' ......................... Suppression affichage de la zone copié
          Filtre.AutoFilter ' ....................................... Suppression du filtre
End Sub
Cliquez pour agrandir...
Hello,
0.21
Comme je l'avais dit à @patricktoulon , le filtre auto semble bien moins rapide que le filtre élaboré
Bonne soiré
 
Vote positif 0 Vote négatif
mapomme

mapomme

XLDnaute Barbatruc
Supporter XLD
Bonjour à tous,

Moi aussi je veux jouer.
Pour 20 000 lignes de données, la durée pour remplir le tableau résultat r est de 0,008 s à 0,016 s.
VB: 
Sub Essai()
Dim deb, der&, t, i&, n&, j&
   deb = Timer: Application.ScreenUpdating = False
   With Sheets("DA")
      der = .Cells(.Rows.Count, "e").End(xlUp).Row
      t = .Range("e5:h" & der)
   End With
   For i = 1 To UBound(t)
      If IsNumeric(t(i, 4)) Then If t(i, 4) > 0 Then n = n + 1
   Next i
   ReDim r(1 To n, 1 To 4): n = 0
   For i = 1 To UBound(t)
      If IsNumeric(t(i, 4)) Then
         If t(i, 4) > 0 Then n = n + 1: For j = 1 To 4: r(n, j) = t(i, j): Next
      End If
   Next i
   MsgBox "Durée construction du tableau résultat r = " & Format(Timer - deb, "0.000\ sec.")
   'vérif
   Sheets("résultat").Columns("a:d").Clear
   Sheets("résultat").Columns("a:d").Resize(UBound(r)) = r
End Sub
 

Pièces jointes

  • BrunoM45- lecture tableau- v1a.xlsm
    27.4 KB · Affichages: 5
Vote positif 0 Vote négatif
mapomme

mapomme

XLDnaute Barbatruc
Supporter XLD
ChTi160 à dit:
il faut aussi tester en mettant le résultat du timer après avoir collé le tableau
jean marie
Cliquez pour agrandir...
Bonsoir @ChTi160 :),

J'ai considéré que la question était (je cite) :

Méthode rapide pour mettre cellules dans variable tableau​

Cliquez pour agrandir...
Donc, logiquement, on ne mesure pas le transfert sur la feuille ;).
C'est pourquoi la durée est comptée quand r est rempli.

nota : pour 20 000 lignes de données, si on mesure après le transfert sur la feuille Résultat, on trouve entre 0,016 et 0,032 s.
 
Dernière édition:
Vote positif 0 Vote négatif
Eric C

Eric C

XLDnaute Barbatruc
Bonsoir le fil

@BrunoM34 - j'ai les neurones qui chauffaient dur...
Je ne sais pas si je dois vous dire quel code je prends 😁
ils sont tous au TOP et ça va m'éviter m'arracher les derniers cheveux que j'ai.
Cliquez pour agrandir...
Je n'aurais pas été d'une grande utilité dans ce fil. Au vu de tes commentaires et à la suite de tes neurones bouillants, tu as choisi de t'auto-congratuler en choisissant ton post #22 comme solution 😂 😂 🤣 🤣 😂 😂
Ne le prends surtout pas mal - Bonne soirée
@+ Eric c
 
Vote positif 0 Vote négatif
laurent950

laurent950

XLDnaute Barbatruc
Bonsoir,

J'ai optimisé :
Pour 1 045 079 Lignes = 2,781 secondes

VB: 
Option Explicit
Sub Test4()
Dim deb As Single
deb = Timer
Application.ScreenUpdating = True
  Dim ShtDA As Worksheet
      Set ShtDA = ThisWorkbook.Worksheets("DA") ' ..................... Feuille DA
  Dim dLig As Long
      dLig = ShtDA.Range("F" & Rows.Count).End(xlUp).Row ' ............ Derniére ligne non vide
  Dim Filtre As Range
      Set Filtre = ShtDA.Range(ShtDA.Cells(4, 5), ShtDA.Cells(dLig, 8)) ' .. Zone de séléction pour Filtre
          Filtre.AutoFilter Field:=4, Criteria1:="<>" ' .............. Filtre sur Place
  Dim Plage As Range
      Set Plage = Filtre.SpecialCells(xlCellTypeVisible) ' .......... Cellule visible de la zone de Filtre
                  Filtre.AutoFilter ' ............................... Suppression du filtre
  Dim ShtResult As Worksheet
      Set ShtResult = Worksheets("Résultat")
  Dim t() As Variant
  Dim i As Long
  ReDim t(1 To Plage.Areas.Count)
        For i = LBound(t) To UBound(t)
            t(i) = Plage.Areas(i).Value
            ShtResult.Cells(i, 1).Resize(UBound(t(i), 1), UBound(t(i), 2)) = t(i)
        Next i
Application.ScreenUpdating = False
MsgBox "Durée construction du tableau résultat r = " & Format(Timer - deb, "0.000\ sec.")
End Sub

Ou

VB: 
Option Explicit
Sub Test7()
Dim deb As Single
deb = Timer
Application.ScreenUpdating = False
  Dim ShtDA As Worksheet
      Set ShtDA = ThisWorkbook.Worksheets("DA") ' ..................... Feuille DA
  Dim dLig As Long
      dLig = ShtDA.Range("F" & Rows.Count).End(xlUp).Row ' ............ Derniére ligne non vide
  Dim Filtre As Range
      Set Filtre = ShtDA.Range(ShtDA.Cells(4, 5), ShtDA.Cells(dLig, 8)) ' .. Zone de séléction pour Filtre
          Filtre.AutoFilter Field:=4, Criteria1:="<>" ' .............. Filtre sur Place
  Dim Plage As Range
      Set Plage = Filtre.SpecialCells(xlCellTypeVisible) ' .......... Cellule visible de la zone de Filtre
                  Filtre.AutoFilter ' ............................... Suppression du filtre
  Dim ShtResult As Worksheet
      Set ShtResult = Worksheets("Résultat")
  Dim t(), temp() As Variant
  ReDim temp(1 To Plage.Areas.Count, 1 To Plage.Areas(1).Count)
  Dim i, j As Long
  ReDim t(1 To Plage.Areas.Count)
        For i = LBound(t) To UBound(t)
            t(i) = Plage.Areas(i).Value
                For j = LBound(temp, 2) To UBound(temp, 2)
                    temp(i, j) = t(i)(1, j)
                    'temp(i, j) = Plage.Areas(i)(1, j)
                Next j
        Next i
        ShtResult.Cells(1, 1).Resize(UBound(temp, 1), UBound(temp, 2)) = temp
Application.ScreenUpdating = True
MsgBox "Durée construction du tableau résultat r = " & Format(Timer - deb, "0.000\ sec.")
End Sub
 
Dernière édition:
Vote positif 0 Vote négatif

Discussions similaires

BenHarber
  • Question
Microsoft 365 Variable tableau : coller uniquement une partie des colonnes
2
Réponses
28
Affichages
671
BenHarber
BenHarber
Z
  • Question
Microsoft 365 Recherche d'une valeur max dans un tableau représentant des paliers
Réponses
3
Affichages
109
zedude
Z
N
  • Question
XL 2019 Aide pour optimiser mon tableau Excel de suivi d'activité
Réponses
6
Affichages
213
Nicolaasss
N
B
  • Résolu(e)
Microsoft 365 affecter des valeurs dans un tableau de noms de variable
Réponses
4
Affichages
663
bérylion
B
P
  • Résolu(e)
XL 2021 Besoin d'aide pour copier/coller données de plusieurs classeurs
2
Réponses
20
Affichages
528
Pac41240
P
P
  • Question
Microsoft 365 Besoin d'aide pour plusieurs petite chose technique sur un fichier excel
8 9 10
Réponses
136
Affichages
8 K
TooFatBoy
TooFatBoy
O
  • Résolu(e)
XL 2013 Mettre à jour un graphique dynamiquement à partir d'une zone de données à dimension variable
Réponses
11
Affichages
870
Olivier P
O
F
  • Question
Microsoft 365 Mettre donné dans un tableau
Réponses
2
Affichages
403
fimo41
F
K
  • Question
Autres [XL2007] copier valeurs tableau cellules non vides triées
Réponses
6
Affichages
383
kif
K
S
  • Résolu(e)
Microsoft 365 - Conseils pour la structuration d'une base de données -
2 3
Réponses
44
Affichages
3 K
crocrocro
C

Membres actuellement en ligne

15 membres et 379 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
314 491
Messages
2 110 180
Membres
110 690
dernier inscrit
Zeppelin