recuperer les donnees dans un tableau d'un seul coup

tigeline001

XLDnaute Occasionnel
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
Code:
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
 
Dernière modification par un modérateur:

tigeline001

XLDnaute Occasionnel
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
Code:
With Feuil3
    Set Plg2 = .Range("A" & j & ":O" & j)
        'Set Plg2 = .Range("A1:N1")
  Plg2.Value = MonTab1

    End With
 

Pièces jointes

  • Classeur1_recup.xlsm
    19.3 KB · Affichages: 33
Dernière modification par un modérateur:

Dranreb

XLDnaute Barbatruc
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 :
VB:
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
 
Dernière édition:

tigeline001

XLDnaute Occasionnel
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

XLDnaute Occasionnel
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

XLDnaute Barbatruc
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

XLDnaute Barbatruc
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.
 

tigeline001

XLDnaute Occasionnel
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

XLDnaute Barbatruc
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.
 

klin89

XLDnaute Accro
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 :
VB:
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
 

Discussions similaires

Statistiques des forums

Discussions
312 088
Messages
2 085 203
Membres
102 818
dernier inscrit
NeoMaint