recuperer les donnees dans un tableau d'un seul coup

[tigeline001]

Bonjour tout le monde
Au niveau du code ci dessous , es ce qu'il y'a possibilité de recuperer les donnees dans le tableau à la fin de la boucle.
j'ai essayé de le faire mais au niveau de la feuille destination il me donne seulemet la derniere ligne recuperée
Merci

Public Sub SERVICE_BEHESP()
Dim MonTab1 As Variant, Compt11 As Long, Plg1 As Range, Plg2 As Range
Dim j As Long
Dim Z As String
Dim trouve As Range
Application.ScreenUpdating = False
With Feuil52
.Range("A1:O1").Copy Feuil60.Range("A1")
    Set Plg1 = .Range("A2:O" & .Range("A" & .Rows.Count).End(xlUp).Row)
     MonTab1 = Plg1.Value
     j = 2
         For Compt11 = LBound(MonTab1, 1) To UBound(MonTab1, 1)
        Z = .Cells(Compt11, 13) & Chr(32) & .Cells(Compt11, 12)
         'Z = MonTab1(Compt11, 13) & Chr(32) & MonTab1(Compt11, 12)
         Set trouve = Feuil53.Columns(9).Find(Z, lookat:=xlWhole)
         If Not trouve Is Nothing Then
             MonTab1 = Feuil52.Range("A" & Compt11 & ":O" & Compt11)
             With Feuil60
    Set Plg2 = .Range("A" & j & ":O" & j)
        'Set Plg2 = .Range("A1:N1")
    Plg2.Value = MonTab1

    End With
             j = j + 1
            End If
        Next Compt11
 End With

With Feuil60
'.Activate
.Columns("A:Y").AutoFit: .Range("A1").CurrentRegion.Borders.LineStyle = 1 'J'ajuste mes colonnes en tailles
Application.Union(.Range("F1"), .Range("G1"), .Range("K1")).EntireColumn.NumberFormat = "dd-mm-yyyy hh:mm:ss"
End With
    Application.ScreenUpdating = True
End Sub

 

[tigeline001]

Re : recuperer les donnees dans un tableau d'un seul coup

Bonjour
Mon code marche bien mais je veux le modifier et je cherche de l'aide,
Au niveau de mon macro je veux juste mettre toutes données dans le tableau avant de le transférer sur la feuile.
Actuellement mon code récupére une ligne dans le tableau et le transfère au même moment ,mais je veux qu'il recupere le tout dans le tableau et à la fin de la boucle le transfere sur la feuille.
je veux pas que ce bout de code se trouve dans la boucle

With Feuil3
    Set Plg2 = .Range("A" & j & ":O" & j)
        'Set Plg2 = .Range("A1:N1")
  Plg2.Value = MonTab1

    End With

 

[Dranreb]

Re : recuperer les donnees dans un tableau d'un seul coup

Bonsoir
Vous voulez que ça fasse quoi ?
Juste copier les lignes de Feuil1 qui ont "c" en colonne 9 vers Feuil3 ?
Votre programmation m'a l'air bien compliquée et inefficace si c'est ça !

Je le ferais comme ça :

Public Sub recup()
Dim T(), LE&, LS&, C&
T = Feuil1.[A1:O1].Resize(Feuil1.Cells(Feuil1.Rows.Count, "A").End(xlUp).Row).Value
LS = 1
For LE = 2 To UBound(T, 1)
   If T(LE, 9) = "c" Then
      LS = LS + 1
      For C = 1 To UBound(T, 2): T(LS, C) = T(LE, C): Next C
      End If: Next LE
Feuil3.Cells.ClearContents
Feuil3.[A1].Resize(LS, UBound(T, 2)).Value = T
End Sub

 

[tigeline001]

Re : recuperer les donnees dans un tableau d'un seul coup

Bonjour Dranreb
oui c est ça que je veux faire,je dois faire ce même traitement pour plusieurs feuilles ce qui ralenti le chargement de mes feuilles c'est pourquoi je veux optimiser le code
Si vous avez quelques choses a me proposer je suis partant
Merci

 

[tigeline001]

Re : recuperer les donnees dans un tableau d'un seul coup

Bonjour
Vraiment merci je vais essayer votre code
j'ai plusieurs feuilles de 300 lignes chacunes je veux les charger a l'ouverture de du classeur(workbook_open) et les codes de chargement
se ressemblent a 80% ,j'espere que ton code fera l'affaire
Merci encore

 

[CISCO]

Re : recuperer les donnees dans un tableau d'un seul coup

Bonjour à tous

Est-ce que cela serait possible sans cette boucle dans le code proposé par Dranreb
For C = 1 To UBound(T, 2): T(LS, C) = T(LE, C): Next C
en remplissant toute la ligne LS du tableau T en une seule fois ?

@ plus

 

[Dranreb]

Re : recuperer les donnees dans un tableau d'un seul coup

Pourquoi ?
Une optimisation plus pointue, économisant des chargement/déchargements de compteur entre mémoire et registre CPU ne serait intéressante que si c'était à faire des milliards de fois. Pour mon système d'indexation j'utilise MoveMemory pour ça, mais ce sont des Long, je doute que ce soit applicable pour des Variant. Si c'est juste une question d'écriture, non. VBA est assez pauvre en matière de commande de manipulation de tableaux.

 

[CISCO]

Re : recuperer les donnees dans un tableau d'un seul coup

Bonjour

Merci Dranreb. C'était juste pour info.

@ plus

 

[tigeline001]

Re : recuperer les donnees dans un tableau d'un seul coup

Bonjour

Merci Dranreb ton code marche très bien ,le chargement devient beaucoup plus rapide .
J`ai une question comment faire pour que le clearContents n'efface pas toute la feuille mais juste la partie generée par le code
Merci

 

[Dranreb]

Re : recuperer les donnees dans un tableau d'un seul coup

Au lieu de mettre Cells mettez une expression Range qui représente la partie que vous voulez effacer.
Je ne comprends pas "la partie générée par le code".
Précédemment vous voulez dire ? Mais on ne la connait pas !
Il faudrait déjà lui mettre un nom ou la mettre sous forme de tableau.

 

[tigeline001]

Re : recuperer les donnees dans un tableau d'un seul coup

Bonjour Dranreb
j'ai utilisé ce code
Feuil54.Range("A1:O65000").ClearContents
et ça marche
Merci encore le chargement marche super bien

 

[klin89]

Re : recuperer les donnees dans un tableau d'un seul coup

Bonsoir tigeline001, Dranreb, CISCO, le forum 🙂

Sans boucle avec la fonction de tableau Filter :

Sub test()
Dim x
    If Application.CountIf(Sheets("Feuil1").Columns(9), "c") = 0 Then Exit Sub
    With Sheets("Feuil1")
        With .Range("a1").CurrentRegion
            x = Filter(.Parent.Evaluate("transpose(if(" & .Columns(9).Address & _
                                        "=""c"",row(1:" & .Rows.Count & "),char(2)))"), Chr(2), 0)
            x = Application.Index(.Value, Application.Transpose(x), _
                                  Evaluate("column(" & .Rows(1).Address & ")"))
        End With
    End With
    With Sheets("Feuil3").Cells(1)
        .Resize(1, UBound(x, 2)).Value = Sheets("Feuil1").Cells(1).CurrentRegion.Rows(1).Value
        .Offset(1).Resize(UBound(x, 1), UBound(x, 2)).Value = x
    End With
End Sub

klin89