Extraire différentes cells ligne et transposer 3 colonnes

Le 08/03/2017 à 17:45

Bonjour au forum.

Dans le cadre de mon activité, j'ai réalisé l'extraction d'un tableau de donnée dispatché sur deux onglet vers la feuille "compta". Le but étant d'extraire les cellules A(i) ; B(i); C(i); Ci); M(i); N(i); O(i) de la même ligne pour les mettre en forme sur trois lignes de le feuille compta. J'ai réussi à réaliser l'opération avec succès, mais mon code est trés trés lent. Du fait qu'en cours d'années j'aurais beaucoup de ligne,je me pose des questions sur sa viabilité.....pour ce code j'ai simplement extrait/repositionné, mais je me demande s'il était possible de passer par des "arrays" ou des tableau à une dimension afin de récupérer les informations non pas par cellule mais par index....le probléme est que mon niveau trés basic ne me permet pas d'optimiser ce code.

Merci pour votre aide

Sébastien

29logbook.xlsm (36.87 Ko)
Le 09/03/2017 à 00:07

Bonsoir sebastienKu, le forum

Pour t'aider, j'ai dégrossi le problème, j'ai eu du mal à piger

Je n'ai traité que la feuille "Journal PRS"

Restitution dans la feuille "Feuil1", qu'il faut créer préalablement.

Il reste des zones d'ombre, j'ai placé des points d'interrogation

Il faut aussi paramétrer les en-têtes de feuilles de calcul en style de référence L1C1, sinon ça bug

Y'a plus qu'à boucler sur toutes les feuilles concernées

Option Explicit
Sub test()
Dim a, b(), i As Long, j As Long, n As Long
    With Sheets("Journal PRS").Cells(1).CurrentRegion
        a = Application.Index(.Value, Evaluate("row(1:" & _
                                               .Rows.Count & ")"), Array(3, 1, 2, 10, 13, 14, 15))
    End With
    ReDim b(1 To UBound(a, 1) * 3, 1 To 7)
    For i = 2 To UBound(a, 1)
        For j = 5 To UBound(a, 2)
            n = n + 1
            b(n, 1) = a(i, 1)
            b(n, 2) = a(i, 4)
            b(n, 3) = "?"    'je ne sais pas quoi inscrire
            b(n, 4) = a(i, 2) & a(i, 3)
            Select Case j
                Case 5
                    b(n, 5) = "?"    'je ne sais pas quoi inscrire
                    b(n, 6) = ""
                    b(n, 7) = a(i, 5)
                Case 6
                    b(n, 5) = "TVA collectée"
                    b(n, 6) = ""
                    b(n, 7) = a(i, 6)
                Case 7
                    b(n, 5) = "?"    'je ne sais pas quoi inscrire
                    b(n, 6) = a(i, 7)
                    b(n, 7) = ""
            End Select
        Next
    Next
    With Sheets("Feuil1").Cells(1)
        .Parent.Cells.Clear
        With .Resize(, 7)
            .Value = [{"Date","Type vente","N° Compte","Facture","Intitulé","TTC","HT - TVA"}]
            .Offset(1).Resize(n).Value = b
        End With
        With .CurrentRegion
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            '.HorizontalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            With .Rows(1)
                .Interior.ColorIndex = 36
                .BorderAround Weight:=xlThin
            End With
            .Columns.AutoFit
        End With
    End With
End Sub

klin89

Le 09/03/2017 à 00:12

Bonsoir,

Si c'est lent avec ce contenu réduit, ça ne s'améliorera pas !

Travailler avec des tableaux et des boucles, on le peut toujours ! Je dirais même qu'en l'absence on n'utilise pas vraiment VBA, on ne fait que de la manipulation Excel automatisée...

Ton code mal indenté ne me fait pas bondir de joie ! Mais si tu es en mesure d'expliquer rationnellement, de façon concise mais complète le déroulement de l'opération visée, je m'y repencherais...

Cordialement.

edit: Tu as déjà une réponse je vois, si elle te convient je passe...

Le 09/03/2017 à 00:34

Salut Sébastien, Klin,

Bonjour MFerrand,

voici ton fichier! Même si, comme d'hab', j'ai un problème avec les dates... encore qui ne se trient pas comme il se doit!

A tester! Evidemment, si tu as d'autres feuilles à ajouter, la macro doit être modifiée!

A+

18logbook.xlsm (40.45 Ko)
Le 09/03/2017 à 12:53

Bonjour à tous, et merci pour avoir consommé du temps sur mon probléme. Comme le cite MFerrand, mon approche vba est plutot une version excel automatisée...mais je sui en auto apprentissage

Merci a Klin et curulis pour leur code vraiment trés opérationnel.

@ Klin, je ne suis pas à l'aise avec cette déclaration

a = Application.Index(.Value, Evaluate("row(1:" & _
                                               .Rows.Count & ")"), Array(3, 1, 2, 10, 13, 14, 15))

Je comprends que l'on cible les colonnes sources à traiter, mais je ne saisie pas Application.Index(.Value, Evaluate...

With .Resize(, 7)
            .Value = [{"Date","Type vente","N° Compte","Facture","Intitulé","TTC","HT - TVA"}]
            .Offset(1).Resize(n).Value = b
        End With

Pour cette ligne, je comprends que l'on commence à écrire à partir de la ligne 1 pour laisser l'entête, mais que signifie .Resize(n).Value = b ? C'est pour reinjecter le tableau b dans Feuil1 ?

@curulis

Merci encore pour le code complet, je me permet aussi quelques infos afin de progresser

  ReDim Preserve tTabF(7, iIdx)

Je ne suis vraiment pas à l'aise avec cette déclaration....le tTabF sera paramétré sur 7 colonnes et ildx lignes c'est ca ?

With Worksheets("Compta")
        iRow = IIf(x = 1, 1, .Cells(Rows.Count, 1).End(xlUp).Row + 1)
        .Range("A" & iRow).Resize(iIdx, 7) = WorksheetFunction.Transpose(tTabF)
        .Range("F" & iRow).Resize(iIdx, 2).Interior.Color = IIf(x = 1, RGB(200, 200, 255), RGB(200, 255, 200))
    End With

Je bloque un peu avec les deux premiéres lignes....je comprends que l'on transpose le tableaux dans la nouvelle feuille mais je ne saisie pas la syntaxe.

J'ai eu l'occasion de travailler sur des listbox ou il était nécessaire de réaliser des tris sur date, et j'ai eu le même problème que vous sur les résultats...lorsque les jours sont de type 03/10/2017, j'ai en retour une réponse en mm/dd/aaaa du coup ma date passe 10/03/2017 ....y a t'il une parade, j'ai esayé avec Cdate() mais sans succés

Tiens en parlant de date, je souhaite pouvoir extraire ce tableau sur une plage de date, mais je ne sais pas par ou commencer, des pistes ? j'aimerais le coder de mon coté...

Merci

Sébastien

Le 09/03/2017 à 13:05

Bonne continuation.

Le 09/03/2017 à 22:04

Bonsoir curulis57, MFerrand, sebastienKu

Le code pour traiter les 2 premières feuilles :

Option Explicit
Sub test()
Dim a, b(), i As Long, j As Long, n As Long, e
    'attention à la 1ère dimension
    ReDim b(1 To 300, 1 To 7)
    For Each e In Array(Array("Journal PRS", "706100", "VENTE SAV"), _
                        Array("Journal VEM", "707100", "VENTE ACCESSOIRES"))
        With Sheets(e(0)).Cells(1).CurrentRegion
            a = .Value
        End With
        For i = 2 To UBound(a, 1)
            For j = 13 To UBound(a, 2)
                n = n + 1
                b(n, 1) = a(i, 3)
                b(n, 2) = a(i, 10)
                b(n, 4) = a(i, 1) & a(i, 2)
                Select Case j
                    Case 13
                        b(n, 3) = e(1)
                        b(n, 5) = e(2)
                        b(n, 6) = Empty
                        b(n, 7) = a(i, 13)
                    Case 14
                        b(n, 3) = "445713"
                        b(n, 5) = "TVA collectée"
                        b(n, 6) = Empty
                        b(n, 7) = a(i, 14)
                    Case 15
                        b(n, 3) = "411000"
                        b(n, 5) = "VENTE M / MME"
                        b(n, 6) = a(i, 15)
                        b(n, 7) = Empty
                End Select
            Next
        Next
    Next
    Application.ScreenUpdating = False
    With Sheets("Feuil1").Cells(1)
        .Parent.Cells.Clear
        With .Resize(, 7)
            .Value = [{"Date","Type vente","N° Compte","Facture","Intitulé","TTC","HT -- TVA"}]
            .Offset(1).Resize(n).Value = b
        End With
        With .CurrentRegion
            .Font.Name = "calibri"
            .Font.Size = 10
            .VerticalAlignment = xlCenter
            '.HorizontalAlignment = xlCenter
            .BorderAround Weight:=xlThin
            .Borders(xlInsideVertical).Weight = xlThin
            With .Rows(1)
                .Interior.ColorIndex = 36
                .BorderAround Weight:=xlThin
            End With
            .Columns.AutoFit
        End With
    End With
    Application.ScreenUpdating = True
End Sub

klin89

Le 09/03/2017 à 22:46

Salut Sébastien,

ReDim Preserve tTabF(7, iIdx)

... car on se sait pas au départ combien d'items on trouvera dans l'extraction. On redimensionne à chaque enregistrement.

Pourquoi (7, iIdx) et pas (iIdx,7) : parce qu'on ne peut redimensionner que l'index 'extérieur'.

D'où, TRANSPOSE quand on veut remettre le tableau de sa 'position' horizontale à verticale! Tu suis?

iRow = IIf(x = 1, 1, .Cells(Rows.Count, 1).End(xlUp).Row + 1)
        .Range("A" & iRow).Resize(iIdx, 7) = WorksheetFunction.Transpose(tTabF)

IIF = immediate IF, une sorte de if... THEN... ELSE... ENDIF

... une boucle x= 1 to 2. Première boucle, la feuille 'Compta' est vide = IIF( x=1,1 --> affichage en ligne 1. Deuxième boucle : affichage en dernière ligne + 1 --> .Cells(.......).Row +1

RESIZE (m'a fallu le temps aussi de piger celle-là!) : plutôt que de spécifier exactement la valeur de la ligne (ou colonne, c'est selon) finale d'affichage, 'j'allonge' la position initiale (Range("A" & iRow.. ) du nombre d'enregistrement (iIdx) connu.

A+

Le 10/03/2017 à 15:35

Bonjour,

@Klin, merci pour le code complet, effectivement il fonctionne parfaitement, ceci sur les deux feuilles!!

@curulis, merci pour les explications, je saisie mieux les tableaux et leur déclaration.

J'ai finalement réussi à résoudre ce probléme de tri de date

        tTab = .Range("A2:O" & iRow).Value2

J'ai déclaré le tTab en .value2 et récupéré le format date avec

.NumberFormat = "dd/mm/yyyy"

Bonne soirée

Sébastein

Rechercher des sujets similaires à "extraire differentes ligne transposer colonnes"