XL 2019 Fusionner deux tableaux en les intercalant

[Victor75]

Bonsoir à tous,

Je suis à la recherche d'une fonction VAB me permettant de fusionner deux tableaux.
D'une manière à ce que le tableau de la colonne B s'intercale dans le tableau de la colonne A.

Romain (colonne B) ira en dessous de Alexis (colonne A)...
Theo (colonne B) en dessous de Antoine (colonne A)...
Et ainsi de suite.

J'aimerais passer de ce tableau :

A ce tableau :

Via un pop-up me permettant de sélectionner le tableau en question :

Est-ce possible ?

Merci d'avance pour votre aide.

 

[soan]

(Re)bonsoir Victor,

ton fichier en retour ; fais Ctrl e ➯ travail effectué.

une boîte de dialogue popup est inutile car la macro détecte
automatiquement la dernière ligne ET la dernière colonne.​

---

code VBA (14 lignes) :

Option Explicit: Option Base 1

Sub Essai()
  If IsEmpty([A1]) Then Exit Sub
  Dim k%: k = Cells(1, Columns.Count).End(1).Column: If k = 1 Then Exit Sub
  Dim n&: n = Cells(Rows.Count, 1).End(3).Row: If n = 1 Then Exit Sub
  Dim T1, T2, i&, j&: T1 = [A1].Resize(n, k): ReDim T2(2 * n, k)
  For i = 1 To n
    For j = 1 To k: T2(2 * i - 1, j) = T1(i, j): Next j
  Next i
  Application.ScreenUpdating = 0: Columns.ClearContents
  [A1].Resize(2 * n - 1, k) = T2
End Sub

soan

 

[Victor75]

Un tout grand merci pour ton retour !
Ce code me sera d'une grande utilité !

J'étais en train de modifier mon message pile quand tu m'as répondu.

Je me demandais s'il était possible également de fusionner deux tableaux en les intercalant (voir mon message de base modifié).

Merci encore pour ton aide via ce premier code

 

[soan]

oh ! j'ai vu que tu as changé l'énoncé !!!

 

[soan]

je vais essayer de faire ton 2ème exo.

 

[Victor75]

oh ! j'ai vu que tu as changé l'énoncé !!!

Oui, vraiment désolé !
Je pense que je l'ai changé pile quand tu m'as répondu !
En tous les cas, cette macro me sera déjà bien utile

Je ne sais pas si ma demande modifiée est également possible

Merci beaucoup

 

[soan]

@Victor75

voici la 2ème version ; fais Ctrl e ➯ travail effectué.

là aussi, une boîte de dialogue popup est inutile !

---

code VBA (13 lignes) :

Option Explicit: Option Base 1

Sub Essai()
  Dim n&: n = Cells(Rows.Count, 1).End(3).Row
  If n = 1 And IsEmpty([A1]) Then Exit Sub
  Dim T1, T2, i&, j&, k&: T1 = [A1].Resize(n, 2): ReDim T2(2 * n)
  For i = 1 To n
    For j = 1 To 2: k = k + 1: T2(k) = T1(i, j): Next j
  Next i
  Application.ScreenUpdating = 0: Columns.ClearContents
  [A1].Resize(2 * n) = Application.Transpose(T2)
End Sub

soan

 

[Robert]

Bonsoir le fil, bonsoir le forum,

Arf ! Moi aussi j'arrive avec une proposition, mais pour le premier énoncé, avec l'événementielle ci-dessous qui réagit au double-clic dans n'importe quelle cellule du tableau :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Dim PL As Range 'déclare la variable PL (PLage)
Dim I As Integer 'déclare la variable I (Incrément)

If Target = "" Then Exit Sub 'si la cible est vide, sort de la procédure
Set PL = Target.CurrentRegion 'définit la plage PL
LD = PL(1, 1).Row 'définit la ligne de début LD de la plage PL
LF = PL.Rows.Count + IIf(LD = 1, 0, LD - 1) 'définit la ligne de fin LF de la plage PL
For I = PL.Rows.Count To 2 Step -1 'boucle inversées sur toutes les lignes I, de la dernière de PL à la ligne 2
    'insère une ligne en décalant les cellules vers les bas
    PL(I, 1).Resize(1, PL.Columns.Count).Insert shift:=xlDown
Next I 'prochaine ligne de la boucle
End Sub

Le fichier :

 

[Victor75]

@Robert @soan

Génial ! Merci à vous deux pour votre aide précieuse !
Ca va beaucoup m'aide

Je ne sais pas si c'est possible...
Si ça ne l'est pas, ce n'est pas grave, vous m'avez déjà bien aidé...

Est-ce qu'il serait possible, après la fusion des 2 tableaux intercalés, d'introduire en Colonne A, successivement :

HI
LO
HI
LO
...

Merci encore !

 

[chris]

Bonjour

Une solution PowerQuery sans VBA

Si la source change, clic droit dans le résultat, Actualiser

 

[Victor75]

Re(bonjour) à tous,

Merci à tous pour votre aide !

Est-t-il est possible d'obtenir, via du VBA et à partir de ce tableau d'origine :

Ce tableau final :

Dans la colonne A → Séparer chaque date
Colonne B → Introduire continuellement les valeurs HI/LO...HI/LO....
Colonne C → Fusionner, de manière intercalé, les colonne C et D du tableau d'origine

Et ce peu importe le nombre de lignes ?

J'annexe le tableau d'origine.

Merci beaucoup !

 

[chris]

RE

4ème version de la demande et VBA demandé avec insistance donc je plie bagages...

 

[Robert]

Re,

J'ai l'impression qu'il nous prend pour des c*** !? Allez hop ! Direct sur ma liste rouge... Il y avait longtemps dis donc...

 

[Jean-Eric]

Bonjour à tous,
Bonjour chris,
Une proposition vba, pour le principe. A adapter !?
Cdlt.

Sub Victor75()
Dim n As Long, tbl, arr(), I As Long, J As Long, k As Long
    With ActiveSheet
        tbl = .Cells(1).CurrentRegion.Resize(, 4).Value2
        For I = 1 To UBound(tbl)
            For J = 3 To 4
                ReDim Preserve arr(3, k + 1)
                arr(0, k) = IIf(k Mod 2 = 0, tbl(I, 1), "")
                arr(1, k) = IIf(k Mod 2 = 0, "HI", "LO")
                arr(2, k) = tbl(I, J)
                k = k + 1
            Next J
        Next I
        With .Cells(1, 8)
            .Resize(k, 3).Value = Application.Transpose(arr)
            .Resize(k).NumberFormat = "m/d/yyyy"
        End With
    End With
End Sub

 

[soan]

Bonjour Victor, le fil,

A) pour ton 1er exo initial, AVANT modif de ton énoncé du post #1 :

* normalement, ça ne se fait pas de changer d'énoncé ! surtout pendant qu'on a déjà commencé à travailler dessus ! (mais ça, tu ne pouvais pas savoir qu'on avait déjà commencé à élaborer une solution)

* c'est car tu as changé d'énoncé que Robert a mis un smiley "En colère" sur ton post #1 ; malgré cette phrase de ton post #3 : « J'étais en train de modifier mon message pile quand tu m'as répondu. » ; et malgré ce texte de ton post #6 :
​

Oui, vraiment désolé !
Je pense que je l'ai changé pile quand tu m'as répondu !
En tous les cas, cette macro me sera déjà bien utile

* moi aussi, j'avais bien failli mettre un smiley "En colère" ; puis j'ai préféré le prendre avec humour, et je t'ai quand même donné une solution pour ton 2ème exo (oui, je parle bien de l'énoncé modifié actuel de ton post #1) ; c'est pas évident de suivre, hein, avec ces changements ! surtout que les lecteurs de cette conversation ne peuvent plus voir le tout premier énoncé initial !​

dans ton post #9 :

Génial ! Merci à vous deux pour votre aide précieuse !
Ça va beaucoup m'aider

merci pour ton retour positif et enthousiaste !

---

B) pour ton exo du post #9, je te donne une solution ici car c'est un petit complément de ton 2ème exo (oui, il s'agit toujours de ton énoncé modifié actuel du post #1).

le fichier est joint en fin de ce post ; fais Ctrl e ➯ travail effectué.
​

code VBA (16 lignes) :

Option Explicit: Option Base 1

Sub Essai()
  Dim n&: n = Cells(Rows.Count, 1).End(3).Row
  If n = 1 And IsEmpty([A1]) Then Exit Sub
  Dim T1, T2, i&, j&, k&: T1 = [A1].Resize(n, 2): ReDim T2(2 * n, 2)
  For i = 1 To n
    For j = 1 To 2
      k = k + 1: T2(k, 1) = IIf(k Mod 2 = 1, "HI", "LO")
      T2(k, 2) = T1(i, j)
    Next j
  Next i
  Application.ScreenUpdating = 0: Columns.ClearContents
  [A1].Resize(2 * n, 2) = T2
End Sub

---

dans ton post #11 :

Merci à tous pour votre aide !

merci pour ton retour !

---

C) pour ton exo du post #11 : je vois que c'est un 2ème complément ! y'en a encore beaucoup comme ça ? ou c'est quand même le dernier changement que tu demandes ? normalement, c'est : 1 sujet = 1 question, et sans que tout c'qu'il y a à faire soit demandé au compte gouttes ! au cas où tu aurais une nouvelle demande qui sera complètement différente : tu devras créer un autre sujet, et surtout ne pas la mettre dans ce présent sujet, qui est déjà bien rempli !

même s'il y a déjà le post #14, j'ai quand même fait ton 2ème complément (voir le post #16 ci-dessous).​

soan