Microsoft 365 Transposition

Brigitte 45 · 8 Juillet 2019

Bonjour Tout Le Monde,
Afin d'effectuer quelques recherches, j'ai téléchargé mon historique d'opérations bancaires depuis 2017. Mais le hic c'est que tout est sur 1 seule colonne avec + de 1200 lignes (4 lignes pour 1 opération). Je souhaite transposer en tableau avec 5 colonnes et autant de lignes que d'opérations.
Je connais la fonction "Transpose" mais je suis obligée de le faire 4 lignes par 4 lignes sinon cela me fait l'inverse : 1200 colonnes pour 1 ligne.

Cela ne m'avance pas. J'ai mis un petit exemple en PJ.
Si l'un(e) d'entre vous a une solution, je lui vouerai une reconnaissance éternelle !

Merci par avance pour votre aide.
Amicalement,
Brigitte

JHA · 8 Juillet 2019

Bonjour à tous,

Pas certain que cela fonctionne mais suivant vos données, à essayer.

JHA

Jacky67 · 8 Juillet 2019

Brigitte 45 à dit:
Bonjour Tout Le Monde,
Mais le hic c'est que tout est sur 1 seule colonne avec + de 1200 lignes (4 lignes pour 1 opération). Je souhaite transposer en tableau avec 5 colonnes et autant de lignes que d'opérations.

Bonjour,
Il n'y a que 3 lignes pour "Retrait espèces" , erreur ou pas ??
Une solution en vba, cela convient ?

chris · 8 Juillet 2019

Bonjour à tous

Tu annonces 4 lignes mais ton exemple en as 3 pour une opération.

Qu'en est-il réellement ?

job75 · 8 Juillet 2019

Bonjour Brigitte 45, JHA, Jacky67, chris,

Voyez le fichier joint et la macro affectée au bouton :

VB:

Sub Transposer()
Dim tablo, resu(), i&, n&
tablo = [A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
ReDim resu(1 To UBound(tablo), 1 To 5)
For i = 1 To UBound(tablo)
    If IsDate(tablo(i, 1)) Then
        n = n + 1
        resu(n, 1) = CDate(tablo(i, 1))
        resu(n, 2) = tablo(i + 1, 1)
        If IsNumeric(tablo(i + 2, 1)) Then
            resu(n, 4 - (tablo(i + 1, 2) > 0)) = tablo(i + 2, 1)
            i = i + 2
        Else
            resu(n, 3) = tablo(i + 2, 1)
            resu(n, 4 - (tablo(i + 3, 1) > 0)) = tablo(i + 3, 1)
            i = i + 3
        End If
    End If
Next
'---restitution---
With Feuil1 'CodeName de la feuille
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[E6] '1ère cellule, à adapter
        If n Then
            .Resize(n, 5) = resu
            .Resize(n, 5).Borders.Weight = xlThin 'bordures
        End If
        .Offset(n).Resize(Rows.Count - n - .Row + 1, 5).Delete xlUp 'RAZ en dessous
    End With
End With
End Sub

A+

Brigitte 45 · 8 Juillet 2019

Jacky67 à dit:
Bonjour,
Il n'y a que 3 lignes pour "Retrait espèces" , erreur ou pas ??
Une solution en vba, cela convient ?

Oups ! Effectivement il manque une cellule. J'ai corrigé le fichier, je le mets en PJ.
Merci beaucoup, je vais tester.

job75 · 8 Juillet 2019

La macro de mon post #5 fonctionne qu'il y ait 1 ou 2 textes à chaque opération.

Mais s'il y en a toujours 2 c'est plus simple, fichier (2) :

VB:

Sub Transposer()
Dim tablo, resu(), i&, n&
tablo = [A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
ReDim resu(1 To UBound(tablo), 1 To 5)
For i = 1 To UBound(tablo)
    If IsDate(tablo(i, 1)) Then
        n = n + 1
        resu(n, 1) = CDate(tablo(i, 1))
        resu(n, 2) = tablo(i + 1, 1)
        resu(n, 3) = tablo(i + 2, 1)
        resu(n, 4 - (tablo(i + 3, 1) > 0)) = CDbl(tablo(i + 3, 1))
        i = i + 3
    End If
Next
'---restitution---
With Feuil1 'CodeName de la feuille
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[E6] '1ère cellule, à adapter
        If n Then
            .Resize(n, 5) = resu
            .Resize(n, 5).Borders.Weight = xlThin 'bordures
        End If
        .Offset(n).Resize(Rows.Count - n - .Row + 1, 5).Delete xlUp 'RAZ en dessous
    End With
End With
End Sub

A+

Brigitte 45 · 8 Juillet 2019

job75 à dit:

La macro de mon post #5 fonctionne qu'il y ait 1 ou 2 textes à chaque opération.

Mais s'il y en a toujours 2 c'est plus simple, fichier (2) :

VB:

Sub Transposer()
Dim tablo, resu(), i&, n&
tablo = [A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
ReDim resu(1 To UBound(tablo), 1 To 5)
For i = 1 To UBound(tablo)
    If IsDate(tablo(i, 1)) Then
        n = n + 1
        resu(n, 1) = CDate(tablo(i, 1))
        resu(n, 2) = tablo(i + 1, 1)
        resu(n, 3) = tablo(i + 2, 1)
        resu(n, 4 - (tablo(i + 3, 1) > 0)) = CDbl(tablo(i + 3, 1))
        i = i + 3
    End If
Next
'---restitution---
With Feuil1 'CodeName de la feuille
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[E6] '1ère cellule, à adapter
        If n Then
            .Resize(n, 5) = resu
            .Resize(n, 5).Borders.Weight = xlThin 'bordures
        End If
        .Offset(n).Resize(Rows.Count - n - .Row + 1, 5).Delete xlUp 'RAZ en dessous
    End With
End With
End Sub

A+

Ouiiiii ça fonctionne. Merciiiiiiiiiiiii à l'infini !

Brigitte 45 · 8 Juillet 2019

job75 à dit:

Bonjour Brigitte 45, JHA, Jacky67, chris,

Voyez le fichier joint et la macro affectée au bouton :

VB:

Sub Transposer()
Dim tablo, resu(), i&, n&
tablo = [A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide, au moins 2 éléments
ReDim resu(1 To UBound(tablo), 1 To 5)
For i = 1 To UBound(tablo)
    If IsDate(tablo(i, 1)) Then
        n = n + 1
        resu(n, 1) = CDate(tablo(i, 1))
        resu(n, 2) = tablo(i + 1, 1)
        If IsNumeric(tablo(i + 2, 1)) Then
            resu(n, 4 - (tablo(i + 1, 2) > 0)) = tablo(i + 2, 1)
            i = i + 2
        Else
            resu(n, 3) = tablo(i + 2, 1)
            resu(n, 4 - (tablo(i + 3, 1) > 0)) = tablo(i + 3, 1)
            i = i + 3
        End If
    End If
Next
'---restitution---
With Feuil1 'CodeName de la feuille
    If .FilterMode Then .ShowAllData 'si la feuille est filtrée
    With .[E6] '1ère cellule, à adapter
        If n Then
            .Resize(n, 5) = resu
            .Resize(n, 5).Borders.Weight = xlThin 'bordures
        End If
        .Offset(n).Resize(Rows.Count - n - .Row + 1, 5).Delete xlUp 'RAZ en dessous
    End With
End With
End Sub

A+

Je n'y connais rien en macro. Une fois que j'ai copié dans le presse papier, je fais quoi ? Merci par avance.

chris · 8 Juillet 2019

Bonjour à tous

Une solution sans VBA par PowerQuery intégré à Excel 365

Fonctionne aussi si un seul texte

Brigitte 45 · 8 Juillet 2019

chris à dit:
Bonjour à tous

Tu annonces 4 lignes mais ton exemple en as 3 pour une opération.

Qu'en est-il réellement ?

Oui, il y a bien 4 lignes, c'est un oubli dans le fichier. Je l'ai corrigé, le voici en PJ.

job75 · 8 Juillet 2019

Brigitte 45 à dit:
Je n'y connais rien en macro. Une fois que j'ai copié dans le presse papier, je fais quoi ?

Alt+F11 pour aller dans VBA, menu Insertion => Module puis Ctrl+V pour y coller le code.

chris · 8 Juillet 2019

RE

Brigitte 45 à dit:
Oui, il y a bien 4 lignes, c'est un oubli dans le fichier. Je l'ai corrigé, le voici en PJ.

Comme je l'ai dit, la solution PowerQuery fonctionne qu'il y ait 3 ou 4 lignes

Il suffit de copier tes données dans le tableau puis données, actualiser Tout

JHA · 8 Juillet 2019

Bonjour à tous,

si tous les 4 lignes, avec la fonction mod()

JHA

Amilo · 8 Juillet 2019

Brigitte 45 à dit:
Oui, il y a bien 4 lignes, c'est un oubli dans le fichier. Je l'ai corrigé, le voici en PJ.

Bonjour Brigitte 45, JHA, Jacky67, Chris, Job75, le forum,
Egalement une proposition avec Power query avec une autre méthode que celle à Chris,

Video_Transposition

P.S La vidéo sera supprimée automatiquement après 7 jours

Cordialement

Microsoft 365 Transposition

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

XLDnaute Nouveau

XLDnaute Barbatruc

Pièces jointes

XLDnaute Nouveau

Pièces jointes

XLDnaute Barbatruc

XLDnaute Barbatruc

XLDnaute Barbatruc

Pièces jointes

XLDnaute Accro

Pièces jointes

Discussions similaires

Partager cette page

Statistiques des forums