XL 2013 VBA Déclarer tableaux (transfert de données plus rapide)

PMG

XLDnaute Junior
Bonjour le forum,

J'aimerai apprendre à déclarer mes tableaux de données correctement pour accélérer le temps de transfert d'un tableau à un autre.
Je précise que mon niveau en VBA est un peu au dessus des pâquerettes!

Exemple, je cherche à transférer les 10 premières valeurs dans un tableau:
VB:
Sub test()
Dim i As Variant
For i = 1 To 200
    If Range("A" & i).value <= 10 Then
        Range ("D" & i). Resize (1, 3).value = Range("A" & i). Resize (1, 3).value
    End If
Next i
End Sub

Comment déclarer 2 tableaux fixes ou 1 tableau variable et un autre fixe, surtout quand ils ne sont pas en "A1" et alignés?
Beaucoup de sujets sur le forum, mais pas évident à comprendre.
Merci pour vos lumières!
PMG
 

Pièces jointes

  • TEST ARRAY 1.xlsm
    19.7 KB · Affichages: 9

_Thierry

XLDnaute Barbatruc
Repose en paix
Bonjour @PMG , le Forum

Si j'ai bien compris, car ton fichier exemple est un peu "confus", je tenterais ceci :

VB:
Sub TabloTabloTablo()
Dim WS As Worksheet
Dim TabRange1 As Variant, TabRange2 As Variant
Dim TabArray() As Variant
Dim i As Long, L As Long
Dim c As Byte

Set WS = ThisWorkbook.Worksheets("Feuil1")

TabRange1 = WS.Range("B3:D200")
TabRange2 = WS.Range("K10:M19")

    For i = 1 To UBound(TabRange1)
        If TabRange1(i, 1) < 10 Then
            ReDim Preserve TabArray(3, L)
            For c = 0 To 2
                TabArray(c, L) = TabRange1(i, c + 1)
            Next
        L = L + 1
        End If
    Next i
    For i = 1 To UBound(TabRange2)
        If TabRange2(i, 1) < 10 Then
            ReDim Preserve TabArray(3, L)
            For c = 0 To 2
                TabArray(c, L) = TabRange2(i, c + 1)
            Next
        L = L + 1
        End If
    Next i
    
 
WS.Range("P2").Resize(UBound(TabArray, 2), UBound(TabArray, 1)) = WorksheetFunction.Transpose(TabArray)
    
End Sub

J'ai essayé de faire un truc direct du style :
TabRange = WS.Range(WS.Range("B3:D200"), WS.Range("K10:M19"))
Pour économiser un loop, le code passe mais le Ubound de TabRange ne montre que 198 (soit la seconde Range non prise en considération)
J'ai aussi essayé avec Union, mais la ça plante...


Bon courage
@+Thierry
 

_Thierry

XLDnaute Barbatruc
Repose en paix
Bonjour @pierrejean , re @PMG , le Forum

Ah j'ai compris l'inverse de toi Pierre-Jean, moi quand PMG parlait de deux tableaux et j'ai compris en lisant :
surtout quand ils ne sont pas en "A1" et alignés?
que le Range("K10:M19") était un de deux tableaux à fusionner en une seule Array ! Toi tu le mets en destination... Mais je comprends aussi tout à fait que l'on peut comprendre comme ceci car c'est le plus logique !
Moi j'envoie le tout en "P2"...

Comme ça PMG a de quoi travailler sur les Array TabRange ou TabArray Dynamiques Séquentielles...

Bien @Toi, @Vous,
@+Thierry
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Re @PMG ;), bonjour @_Thierry :), @pierrejean :),

Je n'ai ni ouvert les fichiers des autres répondeurs ni lu les réponses...
Voici ma version commentée pour le tableau que je place en F2 selon ce que j'ai compris...

@PMG, je vous conseille (c'est mon opinion) :
  • de commencer vos modules par Option Explicit qui oblige à la déclaration des variables, ce qui permet à VBA de détecter les fautes de frappe pour les variables, et de s'interroger sur le type des variables à utiliser.
  • de déclarer vos indices de boucle de type Long et pas variant

VB:
Option Explicit

Sub CopierVersCol_F()
Dim T0 As Single, derlig As Long, t, i As Long, N As Long, j As Long

T0 = Timer
Application.ScreenUpdating = False
With Sheets("Feuil1")
   ' Si un filtre est présent, on affiche toute les données
   ' ( sinon la commande end() ne fonctionne ne pas bien! )
   If .FilterMode Then .ShowAllData
   derlig = .Cells(.Rows.Count, "b").End(xlUp).Row    ' numéro ableau des codes à copier
                                             ' (on a aussi pris la ligne des titres des colonnes)
   t = Range("b2:d" & derlig).Value

   ' maintenant on va parcourir les lignes de t à partir de la ligne de 2
   ' jusqu'à la dernière ligne du tableau qui est Ubound(t)
   ' la première ligne qui vérifie la condition sera recopiée à la ligne 2 de t
   ' la seconde ligne qui vérifie la condition sera recopiée à la ligne 3 de t
   ' la troisième ligne qui vérifie la condition sera recopiée à la ligne 3 de t
   ' et ainsi de suite...
   ' à la fin de boucle, tous les lignes répondant au critère, seront "Tasséee"
   ' en haut du tableau.
   ' comme on aura pris soin de répérer le nombre de lignes tassées en haut, on
   ' pourra transférer le haut du tableau dans la zone résultat.
   ' le tableau a déjà une ligne à conserver en haut (celle des en-têtes donc N=1 au départ)
   N = 1
   For i = 2 To UBound(t)     ' boucle sur t à partir de la ligne 2
      If t(i, 1) <= 10 Then
         ' la condition est vérifiée, on remonte la ligne vers le haut du tableau t
         ' la ligne i (qui vérifie la condition) sera recopiée vers la ligne N+1
         N = N + 1
         ' on recopie les trois colonnes de la ligne i vers la ligne N
         For j = 1 To 3
            t(N, j) = t(i, j)
         Next j
      End If
   Next i
  
   ' A ce stade toutes les lignes répondant à la condition
   ' sont rassemblées sur les N premières lignes de t (y compris les en-têtes de colonnes)
   ' il ne nous reste plus qu'à transférer ces N lignes vers la zone résultat
   ' on va le faire 'en un seul coup'
  
   ' on commence par effacer la zone résultat
   .Range(.Cells(2, "f"), .Cells(.Rows.Count, "h")).Clear
  
   ' on transfère les N premières ligne de t sur la zone résultat
   ' pour cela on définit la bonne zone à partie de F2
   ' et on y place les valeurs du tableau
   ' VBA n'y transfère que les valeurs de t correspondnat à la taille de la zone
   .Range("f2").Resize(N, 3) = t       ' zone à N lignes et 3 colonnes
  
   'un peu de bordure et de couleur et mise en forme
   .Range("f2").Resize(N, 3).Borders.LineStyle = xlContinuous
   .Range("f2").Resize(1, 3).Interior.Color = vbYellow
   .Range("f2").Resize(1, 3).HorizontalAlignment = xlCenter
   .Range("f2").Resize(1, 3).Font.Bold = True
   .Range("g1") = Format(Timer - T0, "0.000") & " sec."
End With
End Sub
 

Pièces jointes

  • PMG- TEST ARRAY- v1.xlsm
    24.4 KB · Affichages: 6
Dernière édition:

PMG

XLDnaute Junior
Bonjour, le Fil, @_Thierry, @pierrejean et Re @mapomme,

Merci pour vos exemples, désolé si je n'ai pas été assez concis dans mon énoncé.
Je veux simplement travailler comme la mentionné @_Thierry sur les Arrays. Je tombe souvent sur des exemples qui ne sont pas assez détaillés pour en comprendre le déroulement.
Mais maintenant je n'ose plus rien dire, merci pour vos codes je vais les étudier et les appliquer à d'autres cas.

@mapomme, j'ai une "incompatibilité de type" avec votre fichier

Question:
Pour copier des données (totalement ou une partie des données) d'un tableau A vers un tableau B, que me conseillez vous d'utiliser?

Les arrays ou est ce qu'une ligne de code comme celle la suffit:
VB:
Sheets("Feuil1").Range("A1:A200").Value = Sheets("Feuil1").Range("D1:D200").Value

Merci
PMG
 

mapomme

XLDnaute Barbatruc
Supporter XLD
Sheets("Feuil1").Range("A1:A200").Value = Sheets("Feuil1").Range("D1: d200").Value
Avec ce code, vous ne recopiez que les valeurs.

Si vous voulez tout copier (yc la mise en forme):
VB:
Sheets("Feuil1").Range("A1:A200").copy Sheets("Feuil1").Range("D1:D200")


Si avant de coller les valeurs, vous voulez les transformer, alors vaut mieux passer par un tableau:
VB:
t= Sheets("Feuil1").Range("A1:A200")

' ici traitement des valeurs de t

Sheets("Feuil1").Range("D1:D200")=t

C'est à vous de choisir en fonction de ce que voulez faire...
 
Dernière édition:

PMG

XLDnaute Junior
Bonjour le forum,

Tjs ds le même sujet pourriez vous svp, corriger ou me montrer comment vous procéder ds vos déclaration de tableau.
J'ai bien étudier vos codes, j'avance ds la compréhension des codes mais je me mélange les pinceaux! MERCI d'avance pour votre aide précieuse!

Je reprends l'exemple de @pierrejean.

Cas n°1: Tableau variable vers tableau fixe (10 lignes, 3 colonnes)
VB:
Dim tablo_origine(), tablo_resultat()

tablo_origine = Range ("B2:D" & Range("B" & Rows.Count).End(xlUp).Row)
ReDim tablo_resultat (1 To 10, 1 To 3)

Cas n°2: Tableau variable structuré vers tableau fixe (10 lignes, 3 colonnes)
Code:
Dim tablo_origine(), tablo_resultat()

tablo_origine = Range ("Tableau1[#ALL]")
ReDim tablo_resultat (1 To 10, 1 To 3)

Là ou ça se gâte!
Cas n°3: Tableau fixe (10 lignes, 3 colonnes) vers Tableau variable
Code:
DL = Range("F" & Rows.Count).End(xlUp).Row + 1

tablo_origine = Range ("B6:D15")
ReDim tablo_resultat (1 To 10, 1 To 3) 'Ca marche!
tablo_resultat (1 To DL, 1 To 3) '?

Cas n°4: Tableau fixe (10 lignes, 3 colonnes) vers Tableau variable structuré
Code:
DL = Range("Tableau2").Rows.Count + 1

tablo_origine = Range ("L6:N15")
tablo_resultat = Range ("Tableau2[#ALL]") '?'

Cas n°5: Tableau fixe (10 lignes, 3 colonnes) vers Tableau Fixe
Code:
tablo_origine = Range ("B6:D15")
ReDim tablo_resultat (1 To 10, 1 To 3) 'Ok

Cas n°6: Tableau fixe (10 lignes, 3 colonnes) vers Tableau Fixe structuré
Code:
tablo_origine = Range ("B6:D15")
tablo_resultat = Range ("Tableau3")CODE]
 

Pièces jointes

  • Exemple Tableaux.xlsm
    42.8 KB · Affichages: 5

Discussions similaires

Statistiques des forums

Discussions
311 540
Messages
2 080 529
Membres
101 234
dernier inscrit
Layani89