XL 2010 Transposition

bobafric

XLDnaute Occasionnel
Salut à tous
Dans la colonne 1 je voudrai créer une macro pour transposé 2 lignes à la fois
dans l'exemple ci-joint :les cellules A2 A3 dans B1 C1
A5 A6 dans B4 C4

J'espère être clair et merci d'avance
 

Pièces jointes

  • TRANSPOSITION.xlsm
    9 KB · Affichages: 5
Solution
Bonjour Bobafric, Efgé,
un essai en PJ avec :
VB:
Sub Transposition()
    Dim DL%, L%
    Application.ScreenUpdating = False
    DL = Range("A65500").End(xlUp).Row
    Range("B1:C" & DL).ClearContents
    For L = 1 To DL Step 3
        Cells(L, "B") = Cells(L + 1, "A")
        Cells(L, "C") = Cells(L + 2, "A")
    Next L
End Sub

Efgé

XLDnaute Barbatruc
Bonjour

Je ne comprend pas le principe:
En $B$1:$C$1 on copie $A$2:$B$2 (donc en face du chiffre en colonne A), et ensuite on copie les lettres en face de la première lettre de la colonne A 🤔

En formule pour copier les lettres en face des chiffres (a mettre en $B$1 et à tirer vers le bas et jusqu'a la colonne C)
VB:
=SI(ESTNUM($A1);DECALER($A1;COLONNES($A:A););"")

Cordialement
 

sylvanu

XLDnaute Barbatruc
Supporter XLD
Bonjour Bobafric, Efgé,
un essai en PJ avec :
VB:
Sub Transposition()
    Dim DL%, L%
    Application.ScreenUpdating = False
    DL = Range("A65500").End(xlUp).Row
    Range("B1:C" & DL).ClearContents
    For L = 1 To DL Step 3
        Cells(L, "B") = Cells(L + 1, "A")
        Cells(L, "C") = Cells(L + 2, "A")
    Next L
End Sub
 

Pièces jointes

  • TRANSPOSITION.xlsm
    15.2 KB · Affichages: 1

bobafric

XLDnaute Occasionnel
Re
@sylvanu

L'intêret d'utiliser Cells() est un gain de temps lié à l'utilisation de valeurs numériques dans l'adressage des cellules.
En utilisant une lettre tu nies le principe.
Pourquoi ne pas utiliser
VB:
Cells(L + 1, 1)
Cordialement
Merci les gars c'est impeccable, les deux solutions fonctionnent super et je trouve sympa l'intérêt de Efgé.
Merci excel-download !!
 

Efgé

XLDnaute Barbatruc
Re
De plus cela n'impacte pas le temps d'exécution.
Chez moi :
VB:
Sub TestAlphaNum()
Dim T!
Dim i&, x&
T = Timer
For i = 1 To 10000000
    x = Cells(Rows.Count, 1).End(xlUp).Row
Next i
Debug.Print Timer - T
End Sub
36,41016 secondes
Code:
Sub TestAlphaNum()
Dim T!
Dim i&, x&
T = Timer
For i = 1 To 10000000
    x = Cells(Rows.Count, "A").End(xlUp).Row
Next i
Debug.Print Timer - T
End Sub
43,62109 secondes.

Choisi ton camps camarade...
Cordialement
 

Discussions similaires

Réponses
1
Affichages
211

Statistiques des forums

Discussions
312 083
Messages
2 085 189
Membres
102 809
dernier inscrit
Sandrine83