XL 2019 URGENT COVID 19 - Macro Transpose

Staple1600

XLDnaute Barbatruc

• 23 Mars 2020

• #2

Bonjour le fil, Ternoise

Ce qui est urgent, c'est que tu relises la charte du forum, camarade!

La charte n'a pas dit (mais c'est écrit dedans) à dit:

2 – Tous les membres du forum répondent gracieusement aux questions. Il n’y a donc aucune obligation de résultat et de délai. Les mots URGENT, SOS, AU SECOURS sont donc à bannir.

Cliquez pour agrandir...

 

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 23 Mars 2020

• #3

Bonjour Ternoise, JM,

Si c'est pour la Covid 19 allons vite.

En A2 de la 2ème feuille, à tirer à droite et vers le bas :

VB:

=INDEX(Liste!$A:$A;COLONNE()+4*(LIGNE()-2))

A+

 

Pièces jointes

• Colonnes(1).xlsx

  10.6 KB · Affichages: 13

Vote positif 0 Vote négatif

T

Ternoise

XLDnaute Occasionnel

• 23 Mars 2020

• #4

Merci beaucoup Job75
C'est nickel.

 

Vote positif 0 Vote négatif

mapomme

XLDnaute Barbatruc

Supporter XLD

• 23 Mars 2020

• #5

Bonjour à tous,

Ou par macro depuis la feuille Feuil1 vers la feuille Feuil2, Cliquez sur le bouton Hop!

edit: bonjour à @job75, @Staple1600, @GALOUGALOU

 

Pièces jointes

• Ternoise- Transposer- v1a.xlsm

  124.2 KB · Affichages: 15

Dernière édition: 23 Mars 2020

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 23 Mars 2020

• #6

Re, Bonjour Job75

COVID-19 ou pas, Excel ne sera pas d'un grand renfort.
Le message#1 parlait d'une macro
En voici une "bricolée" non dans l'urgence mais dans le désœuvrement (pour cause de confinement)

VB:

Sub Transpose()
Dim c As Range, rng As Range
Set rng = [A1].CurrentRegion.Columns(1)
For Each c In rng.Cells
If c.Row Mod 4 = 1 Then
Feuil2.Cells(Rows.Count, 1).End(3)(2).Resize(, 4) = Application.Transpose(c.Resize(4).Value)
End If
Next
End Sub

PS: je sais que c'est plus rapide avec un Array, mais je laisse cela aux urgentistes d'XLD.


EDITION: Bonjour mapomme (je ne t'avais pas vu passé)

 

Vote positif 0 Vote négatif

T

Ternoise

XLDnaute Occasionnel

• 23 Mars 2020

• #7

Merci à tous.

 

Vote positif 0 Vote négatif

GALOUGALOU

XLDnaute Accro

• 23 Mars 2020

• #8

Bonjour le forum bonjour le fil
allez très rustique mais une solution de plus par macro
cordialement
galougalou

 

Pièces jointes

• COVID.xlsm

  20.2 KB · Affichages: 2

Vote positif 0 Vote négatif

Staple1600

XLDnaute Barbatruc

• 23 Mars 2020

• #9

Re

Une autre pour la route

VB:

Sub Transpose_bis()
Dim i&, j&, f As Worksheet: Set f = Sheets("Feuil2")
With Application
  .ScreenUpdating = False
    For i = 1 To Cells(Rows.Count, 1).End(3).Row - 3 Step 4
    j = j + 1: f.Cells(j, 1).Resize(, 4) = .Transpose(Range("A" & i).Resize(4))
    Next i
End With
f.Columns("A:D").AutoFit
End Sub

PS: Normalement , Ternoise n'en a plus besoin.
Il doit être au tél pour contacter ces 2750 patients



EDITION: Bonjour jmfmarques

 

Dernière édition: 23 Mars 2020

Vote positif 0 Vote négatif

job75

XLDnaute Barbatruc

• 23 Mars 2020

• #10

Bonjour mapomme, GALOUGALOU,

Ma formule du post #3 est tellement simple qu'il faut l'utiliser même en VBA :

VB:

Private Sub Worksheet_Activate()
With [A2].Resize(Application.Ceiling(Application.CountA(Sheets("Liste").Columns(1)), 4) / 4, 4)
    .Formula = "=INDEX(Liste!$A:$A,COLUMN()+4*(ROW()-2))"
    .Value = .Value 'supprime les formules
End With
End Sub

Elle se déclenche quand on active la 2ème feuille du fichier joint.

A+

 

Pièces jointes

• Colonnes VBA(1).xlsm

  16.4 KB · Affichages: 8

Vote positif 0 Vote négatif

J

jmfmarques

XLDnaute Accro

• 23 Mars 2020

• #11

Bonjour à tous
C'est vrai, que le confinement conduit à l'ennui et qu'on ne sait plus quoi inventer, y compris ce qu'il y a de plus fou.
Allez -->> une méthode que je ne conseillerais pas (même à mon ennemi le konard_virus), mais qui a le mérite d'amuser --->>

VB:

Set toto = Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
Set titi = Range("A1:D" & toto.Count / 4)
For k = 1 To toto.Count
  titi(k) = toto(k)
  If k > 1 Then toto(k) = ""
Next

 

Vote positif 0 Vote négatif

mapomme

XLDnaute Barbatruc

Supporter XLD

• 23 Mars 2020

• #12

Bonjour @jmfmarques,

Attention! Si jamais le nombre de lignes n'est pas un multiple de 4 alors ça coince.
je ferai plutôt: Set titi = Range("A1 : D" & 1 + toto.Count \ 4)

 

Dernière édition: 23 Mars 2020

Vote positif 0 Vote négatif

J

jmfmarques

XLDnaute Accro

• 23 Mars 2020

• #13

Bonjour mapomme
Tu as raison (je n'avais pas prévu des données in complètes).
Mais dans ce cas : inversons donc le signe / --->> \ pour définir titi :

VB:

Set titi = Range("A1:D" & toto.Count \ 4)

 

Vote positif 0 Vote négatif

mapomme

XLDnaute Barbatruc

Supporter XLD

• 23 Mars 2020

• #14

Re @jmfmarques,

Alors ce qui suit semble le faire aussi:

VB:

Set titi = Range("A1:D4")

 

Vote positif 0 Vote négatif

chris

XLDnaute Barbatruc

• 23 Mars 2020

• #15

Bonjour à tous

Une solution PowerQuery intégré à Excel 2019

Mise à jour par Données, Actualiser tout

 

Pièces jointes

• Croiser_4Lignes_PQ.xlsx

  19.1 KB · Affichages: 6

Vote positif 0 Vote négatif