[VBA] Fusionner le texte de cellules contigues en VBA Excel (Urgent)

Fusionner le texte de cellules contigues en VBA Excel (Urgent) [VBA] - VB/VBA/VBS - Programmation

Marsh Posté le 25-04-2002 à 17:00:47    

Salut,  
 
J'ai un problème urgent en VBA sous Excel, je dois écrire une macro qui va fusionner le texte de plusieurs colonnes contigues
et ce, ligne par ligne:
 
Ca donne ça:
----------------------------
Texte 1 | Texte 2 | Texte 3|
----------------------------
Ligne 2 | Toto4   | titi   |
----------------------------
....
 
Je veux en faisant une selection sur les cases à fusionner que ca donne ça:
-------------------------------------
Texte1 Texte2 Texte3 |      |       |
-------------------------------------
Ligne 2 Toto4 titi   |      |       |
-------------------------------------
.....
 
J'ai écrit le code suivant:
Sub MacroFusion()
 
Dim Colonne As Integer
Dim Ligne As Integer
Dim ColonneFin As Integer
Dim LigneFin As Integer
Dim CurrentSel As Excel.Range
Dim cell1_cont As Variant
Dim cell2_cont As Variant
 
CurrentSel = Application.ActiveSheet.CurrentRegion.Cells
Colonne = CurrentSel.Column
Ligne = CurrentSel.Row
ColonneFin = CurrentSel.Columns(CurrentSel.Columns.Count)
LigneFin = CurrentSel.Rows(CurrentSel.Rows.Count)
 
For i = Ligne To LigneFin
    Range(Chr(64 + Colonne) & CStr(i)).Select
    cell1_cont = ActiveCell.FormulaR1C1
    ActiveCell.FormulaR1C1 = ""
     
    Range(Chr(65 + Colonne) & CStr(i)).Select
    cell2_cont = ActiveCell.FormulaR1C1
    ActiveCell.FormulaR1C1 = cell1_cont & " " & cell2_cont
    Next i
End Sub
 
La partie du code récupérant la séléction courante ne fonctionne pas.
 
Voici ma question: Comment récupérer la selection courante dans Excel ?
 
Quelqu'un peut il réussir à faire marcher ce bout de code (qui ne gère que deux colonnes pour l'instant)
 
Désolé le code ci dessus doit être mal programmé mais c'est ma première expérience en VB (je fais plutot du C/C++ MFC/Win32...)

Reply

Marsh Posté le 25-04-2002 à 17:00:47   

Reply

Marsh Posté le 25-04-2002 à 17:31:10    

UP plz c urgent :)

Reply

Marsh Posté le 26-04-2002 à 11:40:17    

Bon bah j'ai finalement réussi à coder le truc si ça interesse quelqu'un:
 

Citation :

Sub MacroFusion()
 
Dim Colonne As Long
Dim Ligne As Long
Dim ColonneFin As Long
Dim LigneFin As Long
Dim ResultCell As Variant
 
With Selection
    Ligne = .Cells(1).Row
    LigneFin = .Cells(.Cells.Count).Row
    Colonne = .Cells(1).Column
    ColonneFin = .Cells(.Cells.Count).Column
End With
 
For i = Ligne To LigneFin
    ResultCell = ""
    For j = Colonne To ColonneFin
        Range(Chr(64 + j) & CStr(i)).Select
        ResultCell = ResultCell & " " & ActiveCell.FormulaR1C1
        ActiveCell.FormulaR1C1 = ""
        Next j
    Range(Chr(64 + Colonne) & CStr(i)).Select
    ActiveCell.FormulaR1C1 = ResultCell
    Next i
Range(Chr(64 + Colonne + 1) & CStr(Ligne), Chr(64 + ColonneFin) & CStr(LigneFin)).Select
Selection.Delete Shift:=xlToLeft
End Sub

Reply

Marsh Posté le 11-02-2009 à 11:29:40    

Bonjour,
 
Merci pour votre macro.
 
Cependant elle fonction correctement uniquement si je selection 2 colonnes entières, et sa mouline jusqu'à la fin...
Lorsque je sélection uniquement les colonnes (A et B) à valeurs, il m'étale la valeur de la colonne G sur FGH ?.
Peut-être un bug, pourquoi FGH ?.
 
Merci d'avance pour votre réponse.
 
Cordialement.
 
 
 

slashp a écrit :

Bon bah j'ai finalement réussi à coder le truc si ça interesse quelqu'un:
 

Citation :

Sub MacroFusion()
 
Dim Colonne As Long
Dim Ligne As Long
Dim ColonneFin As Long
Dim LigneFin As Long
Dim ResultCell As Variant
 
With Selection
    Ligne = .Cells(1).Row
    LigneFin = .Cells(.Cells.Count).Row
    Colonne = .Cells(1).Column
    ColonneFin = .Cells(.Cells.Count).Column
End With
 
For i = Ligne To LigneFin
    ResultCell = ""
    For j = Colonne To ColonneFin
        Range(Chr(64 + j) & CStr(i)).Select
        ResultCell = ResultCell & " " & ActiveCell.FormulaR1C1
        ActiveCell.FormulaR1C1 = ""
        Next j
    Range(Chr(64 + Colonne) & CStr(i)).Select
    ActiveCell.FormulaR1C1 = ResultCell
    Next i
Range(Chr(64 + Colonne + 1) & CStr(Ligne), Chr(64 + ColonneFin) & CStr(LigneFin)).Select
Selection.Delete Shift:=xlToLeft
End Sub



Reply

Marsh Posté le 11-02-2009 à 11:35:04    

Rebonjour,
 
Autant pour moi.
Cela

Reply

Marsh Posté le 11-02-2009 à 11:36:11    

Cela fonctionne, il fallait juste ajuster les colonnes FGH.
Merci encore pour votre macro.
Cordialement.

Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed