[amélioration code VBA] tableau en mémoire

Bonjour,

J'ai l'impression d'enfin me débrouiller un tout petit peu avec les tableaux en mémoire. Si cela ne vous émeut que peu, sachez que de mon côté ça me met tout en joie.

À tel point que j'aimerais bien progresser encore plus.

Dans le fichier ci-joint j'arrive à mes fins, à savoir obtenir une vraie base de données à partir de pas grand chose ...

Comment serait-il possible d'améliorer ce code ? Je déclare au début le nombre maximum de lignes que peut contenir mon tableau, sans être convaincu que ce soit l'idéal. Puis par la suite j'ai quand même pas mal de IF imbriqués. Si j'avais 25 colonnes à traiter, j'imagine que ça coincerait. Quelle serait la bonne démarche ?
Par avance merci pour vos conseils éclairés.

Option Base 1
Sub recup()
Dim tablo()
Dim j As Integer
ReDim tablo(93, 4) '93 étant le nombre maximum de lignes possibles
j = 0
For i = 10 To 40 'lignes 10 à 40 où se trouvent les jours du mois
If WorksheetFunction.CountIf(Range("D" & i & ":F" & i), "X") > 0 Then
    If Range("D" & i) = "X" Then
            j = j + 1
            tablo(j, 1) = Range("A" & i)
            tablo(j, 2) = [B6]
            tablo(j, 3) = Range("C" & i)
            tablo(j, 4) = Range("D8")
    Else: End If
        If Range("E" & i) = "X" Then
                j = j + 1
                tablo(j, 1) = Range("A" & i)
                tablo(j, 2) = [B6]
                tablo(j, 3) = Range("C" & i)
                tablo(j, 4) = Range("E8")
        Else: End If
            If Range("F" & i) = "X" Then
                    j = j + 1
                    tablo(j, 1) = Range("A" & i)
                    tablo(j, 2) = [B6]
                    tablo(j, 3) = Range("C" & i)
                    tablo(j, 4) = Range("F8")
            Else: End If
End If
Next
ReDim Preserve tablo(UBound(tablo, 1), UBound(tablo, 1) + 1)
Range("I2").Resize(UBound(tablo, 1), UBound(tablo, 1) + 1) = (tablo)
End Sub

Bonsoir,

je vous propose ce code :

Sub LRD()
    Dim tablo()
    Dim j As Integer
    j = 0
    With Range("D10")
        For i = 0 To 29 'lignes 10 à 40 où se trouvent les jours du mois
            For k = 0 To 2
                If UCase(.Offset(i, k).Value) = "X" Then
                    j = j + 1
                    ReDim Preserve tablo(1 To 4, 1 To j)
                    tablo(1, j) = .Offset(i, -3)
                    tablo(2, j) = .Offset(-4, -2)
                    tablo(3, j) = .Offset(i, -1)
                    tablo(4, j) = .Offset(-2, k)
                End If
            Next k
        Next i
        .Offset(-8, 4).Resize(UBound(tablo, 2), UBound(tablo, 1)) = Application.Transpose(tablo)
    End With
End Sub

Mais j'ai vu qu'il y avait un soucis pour les dates "ambigües" le 01/11/2020 => 11/01/2020

@ bientôt

LouReeD

Après avoir mis un timer, sur ma machine :

votre code : 0,0625
mon code : 0,0156 , mais avec une erreur sur les dates !

@ bientôt

LouReeD

Avec les commentaires qui me sont si chers !!!!

Sub LRD()
    Dim tablo() ' on ne fait pas attention à sa taille
    Dim j As Integer
    j = 0 ' correspond à l'index "2" du tableau, le nombre de ligne de ce dernier
    With Range("D10") ' à partir de "D10" car le code est basé sur le décalage des cellules
        For i = 0 To 29 ' lignes où se trouvent les jours du mois, de 0 à 29 pour la même raison du décalage
            For k = 0 To 2 ' les colonnes, ici il y en a 3, donc 0 à 2 du fait de la technique du décalage
                If UCase(.Offset(i, k).Value) = "X" Then ' on fait un test sur la majuscule afin de compter les "x" minuscules
                    j = j + 1 ' on a trouver une occurance, on incrémente l'index du tableau
                    ReDim Preserve tablo(1 To 4, 1 To j) ' on remensionne le tableau en préservant les données
                    ' dans ce cas seule la dernière dimension est redimensionnable, c'est pourquoi le tableau est "à l'envers" du votre
                    ' on inscrit les données
                    tablo(1, j) = .Offset(i, -3)
                    tablo(2, j) = .Offset(-4, -2)
                    tablo(3, j) = .Offset(i, -1)
                    tablo(4, j) = .Offset(-2, k)
                End If
            Next k
        Next i
        ' on colle le résultat avec un "transpose" pour remettre les données dans l'ordre vertical
        .Offset(-8, 4).Resize(UBound(tablo, 2), UBound(tablo, 1)) = Application.Transpose(tablo)
    End With
End Sub

@ bientôt

LouReeD

Bon sang, je ne bosse vraiment pas assez avec un 2ème incrément.
Merci beaucoup, c'est effectivement beaucoup mieux.
J'ai de grosses lacunes en algorithmes, qui sont ici criantes.

Pour le Ucase de la croix c'est une bonne idée même si ici elle sera issue d'une formule et donc toujours en majuscule. Mais il faut savoir se prémunir des erreurs et je devrais prendre l'habitude de l'ajouter systématiquement.

Maintenant ça serait super de savoir pourquoi avec cette méthode les dates sont reconnues au format américain.

Encore merci bien en tout cas, j'y vois plus clair maintenant. Je vais essayer de m'en inspirer.

Et si les données sont dans un tableau structuré, alors les "limites" des compteurs deviennent variable... donc plus de 0 to 2, mais colonne X de départ au nombre de colonne du tableau s'il le faut... Pareil pour les lignes...

Mais les "grand" qui trainent par ici vous donneraient un code plus "puissant" et sans erreur de date !

@ bientôt

LouReeD

C'est étrange, même avec format(...) cdate(...) les dates sont toujours mal interprétées.

Justement, je les attends, les "grands"... je les attends :D

Intéressant :

DateSerial(Year(.Offset(i, -3)), Month(.Offset(i, -3)), Day(.Offset(i, -3)))

ne fonctionne pas non plus.

Dans la fenêtre d'exécution,

? Range("D10").Offset(i, -3).Value

donne 01/11/2020 avant le lancement de la macro. C'est stocké dans le tableau ainsi. C'est au moment du collage du tableau que la date change de format et devient le 11/01/2020.

C'est ce qui arrive souvent quand on passe des dates entre VBA et les feuilles, mais quand c'est date après date, on peut le gérer, mais lorsque c'est du à une recopie de tableau entier, il faut peut-être jouer sur le format après le collage, ou bien mettre la donnée en "CLng" dans le tableau puis formater les cellules après la copie sur la feuille.

@ bientôt

LouReeD

Sub LRD()
    Dim tablo() ' on ne fait pas attention à sa taille
    Dim j As Integer
    j = 0 ' correspond à l'index "2" du tableau, le nombre de ligne de ce dernier
    With Range("D10") ' à partir de "D10" car le code est basé sur le décalage des cellules
        For i = 0 To 29 ' lignes où se trouvent les jours du mois, de 0 à 29 pour la même raison du décalage
            For k = 0 To 2 ' les colonnes, ici il y en a 3, donc 0 à 2 du fait de la technique du décalage
                If UCase(.Offset(i, k).Value) = "X" Then ' on fait un test sur la majuscule afin de compter les "x" minuscules
                    j = j + 1 ' on a trouver une occurance, on incrémente l'index du tableau
                    ReDim Preserve tablo(1 To 4, 1 To j) ' on remensionne le tableau en préservant les données
                    ' dans ce cas seule la dernière dimension est redimensionnable, c'est pourquoi le tableau est "à l'envers" du votre
                    ' on inscrit les données
                    tablo(1, j) = CLng(.Offset(i, -3))
                    tablo(2, j) = .Offset(-4, -2)
                    tablo(3, j) = .Offset(i, -1)
                    tablo(4, j) = .Offset(-2, k)
                End If
            Next k
        Next i
        ' on colle le résultat avec un "transpose" pour remettre les données dans l'ordre vertical
        .Offset(-8, 4).Resize(UBound(tablo, 2), UBound(tablo, 1)) = Application.Transpose(tablo)
        .Offset(-8, 4).EntireColumn.NumberFormat = "m/d/yyyy"
    End With
End Sub

Le mieux serait de cibler que les lignes utilisées...

@ bientôt

LouReeD

Ahah j'étais arrivé au même code du coup sur vos indications !

Encore un immense merci !

Je laisse le post encore ouvert demain, des fois qu'un VBiste aguerri nous donne un code plus propre, et je le passe en résolu demain soir si on n'a pas de nouvelles.

(les données vont être collées dans un tableau structuré donc ça ne sera pas un souci de ne convertir que la plage concernée.)

Plus propre ?!

@ bientôt

LouReeD

LouReeD a écrit :

Mais les "grand" qui trainent par ici vous donneraient un code plus "puissant" et sans erreur de date !

Votre fichier avec votre code élargie à la colonne Q, suivi du mien pour les même conditions... Si ce n'est pas propre, c'est tout de même bien rangé !

@ bientôt

LouReeD

Ahah on est effectivement déjà plutôt bien parti.

À savoir que sur mon PC je n'ai qu'un écart de 0.012 au niveau du temps d'exécution ^^.

Oui j'ai vu que la série de if n'est pas moins rapide que la boucle, mais cette dernière est "plus lisible" si on veut dire... Et surtout elle est plus simple à gérer en cas de réduction ou augmentation du tableau dans un sens ou dans l'autre.

@ bientôt

LouReeD

C'est certain.
Pour info, macro terminée. Quand on colle dans un tableau structuré, les données viennent directement au bon format date. Pas besoin de les retransformer.

Sub recup()
    Dim tablo() ' on ne fait pas attention à sa taille
    Dim j As Integer
    j = 0 ' correspond à l'index "2" du tableau, le nombre de lignes de ce dernier
    With Range("D10") ' à partir de "D10" car le code est basé sur le décalage des cellules
        For i = 0 To 30 ' lignes où se trouvent les jours du mois, de 0 à 29 pour la même raison du décalage
            For k = 0 To 2 ' les colonnes, ici il y en a 3, donc 0 à 2 du fait de la technique du décalage
                If UCase(.Offset(i, k).Value) = "X" Then ' on fait un test sur la majuscule afin de compter les "x" minuscules
                    j = j + 1 ' on a trouvé une occurrence, on incrémente l'index du tableau
                    ReDim Preserve tablo(1 To 4, 1 To j) ' on redimensionne le tableau en préservant les données
                    ' dans ce cas seule la dernière dimension est redimensionnable
                    tablo(1, j) = CLng(.Offset(i, -3))
                    tablo(2, j) = .Offset(-4, -2)
                    tablo(3, j) = .Offset(i, -1)
                    tablo(4, j) = .Offset(-2, k)
                End If
            Next k
        Next i
        ' on colle le résultat avec un "transpose" pour remettre les données dans l'ordre vertical
With Feuil5.Range("BDD_livraisons")
        If .Rows.Count = 1 Then
            .Cells(1, 1).Resize(UBound(tablo, 2), UBound(tablo, 1)) = Application.Transpose(tablo)
        Else:
            .Cells(.Rows.Count + 1, 1).Resize(UBound(tablo, 2), UBound(tablo, 1)) = Application.Transpose(tablo)
End If
End With
    End With
End Sub

Bonjour à tous,

Je me suis prêté à l'exercice en essayant d'appliquer les règles pour accélérer : lecture en 1 fois dans un tableau et travail complet en mémoire
Résultat : 50% plus lent que vous
Et je me suis aperçu que vous ne faisiez pas le ménage avant de coller bande de sagouins !
En le supprimant, la pratique rejoint la théorie, c'est plus rapide
eric

bonsoir,

je me suis prêté au jeu.

option base 1
Sub recupbis()
    With ActiveSheet
    Dim t(100, 4)
        dl& = .Cells(Rows.Count, 1).End(xlUp).Row
        d = .Range("A8:F" & dl).Value2
        nom$ = .Range("B6")
        k& = 0
        For i& = LBound(d) + 2 To UBound(d)
            For j& = 4 To 6
                If d(i, j) = "X" Then
                    k = k + 1
                    t(k, 1) = d(i, 1)
                    t(k, 2) = nom
                    t(k, 3) = d(i, 3)
                    t(k, 4) = d(1, j)
                End If
            Next j
        Next i
        .Range("I2").Resize(k, 4) = t
End Sub

Merci beaucoup Eriiic et h2so4 pour vos retours, ça me fait vraiment super plaisir.

Surtout que, h2so4, c'est en très grande partie grâce à toi que j'ai réussi à obtenir le résultat que je souhaitais avec tes dernières réponses à mes questions. Je mesure les progrès qu'il me reste à faire pour obtenir les résultats de façon satisfaisante.

Je vais essayer d'ingérer vos façons de faire.

Encore merci à vous, ainsi qu'à LouReed également :D

Question subsidiaire, vous avez une façon plus rapide de coller les données en dernière ligne d'un tableau structuré que ça ?

With Feuil5.Range("BDD_livraisons")
        If .Rows.Count = 1 Then
            .Cells(1, 1).Resize(UBound(tablo, 2), UBound(tablo, 1)) = Application.Transpose(tablo)
        Else:
            .Cells(.Rows.Count + 1, 1).Resize(UBound(tablo, 2), UBound(tablo, 1)) = Application.Transpose(tablo)
        End If
End With