J'ai dans les colonnes F,G et H des N° de téléphone.
Pour ces colonnes, j'utilise le format spécial téléphone qui permet
d'avoir les valeurs sous la forme uniforme 01 23 45 67 89 quelque soit
la façon dont ils sont saisis.
Pour concaténer ces 3 colonnes, j'utilise la macro ci-dessous.
Chaque N° étant séparé par " / ".
Mon problème est que lors de la concaténation, je perds cette mise en forme.
Comment serait-il possible de la conserver ? Pour obtenir
01 23 45 67 89 / ab cd ef gh ij / ...
Merci d'avance de votre aide.
Sub Concatenation_tph()
' Crée la colonne de concaténation des Tph
'
Dim lg As Integer
lg = ActiveWorkbook.Sheets("Liste").Range("A65536").End(xlUp)(1).Row
Range("A1").Select
' Insère une colonne en I
Columns("I:I").Select
Selection.Insert Shift:=xlToRight
' Met le titre à la colonne
Range("I1").Select
ActiveCell.FormulaR1C1 = "Tph"
' Concaténation des premières valeurs en I2
Range("I2").Select
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-3],"" / "",RC[-2],"" /
"",RC[-1])"
' Continue la concaténation pour les lignes suivantes
Selection.AutoFill Destination:=Range("I2:I" & lg), Type:=xlFillDefault
Range("I2:I" & lg).Select
' Copier/Coller sur place des valeurs pour supprimer les formules
Columns("I:I").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone,
SkipBlanks _
:=False, Transpose:=False
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
MichD
Bonjour,
Essaie comme ceci :
Tu adaptes le nom de la feuille et la plage de cellules. Dans l'exemple, les numéros de téléphone sont dans les colonnes A, B, C, D et le résultat de la concaténation s'affiche en colonne E '-------------------------------------------- Sub test() Dim R As Range, C As Range, T As String
With Worksheets("Feuil1") With .Range("A1:D5") For Each R In .Rows For Each C In R.Cells T = T & Format(C.Value, "##"" ""##"" ""##"" ""##"" ") Next If T <> "" Then .Range("E" & R.Row) = Left(T, Len(T) - 3) T = "" End If Next End With End With Application.EnableEvents = True Application.ScreenUpdating = True End Sub '--------------------------------------------
Bonjour,
Essaie comme ceci :
Tu adaptes le nom de la feuille et la plage de cellules.
Dans l'exemple, les numéros de téléphone sont dans les colonnes A, B, C, D
et le résultat de la concaténation s'affiche en colonne E
'--------------------------------------------
Sub test()
Dim R As Range, C As Range, T As String
With Worksheets("Feuil1")
With .Range("A1:D5")
For Each R In .Rows
For Each C In R.Cells
T = T & Format(C.Value, "##"" ""##"" ""##"" ""##"" ")
Next
If T <> "" Then
.Range("E" & R.Row) = Left(T, Len(T) - 3)
T = ""
End If
Next
End With
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'--------------------------------------------
Tu adaptes le nom de la feuille et la plage de cellules. Dans l'exemple, les numéros de téléphone sont dans les colonnes A, B, C, D et le résultat de la concaténation s'affiche en colonne E '-------------------------------------------- Sub test() Dim R As Range, C As Range, T As String
With Worksheets("Feuil1") With .Range("A1:D5") For Each R In .Rows For Each C In R.Cells T = T & Format(C.Value, "##"" ""##"" ""##"" ""##"" ") Next If T <> "" Then .Range("E" & R.Row) = Left(T, Len(T) - 3) T = "" End If Next End With End With Application.EnableEvents = True Application.ScreenUpdating = True End Sub '--------------------------------------------
Daniel
Bonjour Michel et bonjour à toutes et à tous,
Je ne suis pas du tout aguerri aux boucles imbriquées et bien évidement dans l'adaptation, comme c'est souvent le cas c'est l'interface entre le siège et le clavier qui merdouille...
J'ai modifié ainsi votre macro mais le résultat obtenu n'est pas celui attendu et je ne comprend pas du tout pourquoi 1°) cela met les résultats en colonne N et pas en colonne I. 2°) si je mets F2 à la place de F1, les consignes sont bien faites sur les lignes demandées (F2 à Hlg) mais l'ensemble des résultats est alors décalé d'une ligne.
Sub test() Dim R As Range, C As Range, T As String Dim lg As Integer lg = ActiveWorkbook.Sheets("Feuil5").Range("A65536").End(xlUp)(1).Row
With Worksheets("Feuil5") With .Range("F1:H" & lg) For Each R In .Rows For Each C In R.Cells T = T & Format(C.Value, "00"" ""##"" ""##"" ""##"" ""##"" ") Next If T <> "" Then .Range("I" & R.Row) = Left(T, Len(T) - 3) T = "" End If Next End With End With Application.EnableEvents = True Application.ScreenUpdating = True End Sub
Merci d'avance pour l'éclairage de ma lanterne. Daniel
Le 21/04/2014 13:12, MichD a écrit :
Bonjour,
Essaie comme ceci :
Tu adaptes le nom de la feuille et la plage de cellules. Dans l'exemple, les numéros de téléphone sont dans les colonnes A, B, C, D et le résultat de la concaténation s'affiche en colonne E '-------------------------------------------- Sub test() Dim R As Range, C As Range, T As String
With Worksheets("Feuil1") With .Range("A1:D5") For Each R In .Rows For Each C In R.Cells T = T & Format(C.Value, "##"" ""##"" ""##"" ""##"" ") Next If T <> "" Then .Range("E" & R.Row) = Left(T, Len(T) - 3) T = "" End If Next End With End With Application.EnableEvents = True Application.ScreenUpdating = True End Sub '--------------------------------------------
Bonjour Michel et bonjour à toutes et à tous,
Je ne suis pas du tout aguerri aux boucles imbriquées et bien évidement
dans l'adaptation, comme c'est souvent le cas c'est l'interface entre le
siège et le clavier qui merdouille...
J'ai modifié ainsi votre macro mais le résultat obtenu n'est pas celui
attendu et je ne comprend pas du tout pourquoi
1°) cela met les résultats en colonne N et pas en colonne I.
2°) si je mets F2 à la place de F1, les consignes sont bien faites sur
les lignes demandées (F2 à Hlg) mais l'ensemble des résultats est alors
décalé d'une ligne.
Sub test()
Dim R As Range, C As Range, T As String
Dim lg As Integer
lg = ActiveWorkbook.Sheets("Feuil5").Range("A65536").End(xlUp)(1).Row
With Worksheets("Feuil5")
With .Range("F1:H" & lg)
For Each R In .Rows
For Each C In R.Cells
T = T & Format(C.Value, "00"" ""##"" ""##"" ""##""
""##"" ")
Next
If T <> "" Then
.Range("I" & R.Row) = Left(T, Len(T) - 3)
T = ""
End If
Next
End With
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Merci d'avance pour l'éclairage de ma lanterne.
Daniel
Le 21/04/2014 13:12, MichD a écrit :
Bonjour,
Essaie comme ceci :
Tu adaptes le nom de la feuille et la plage de cellules.
Dans l'exemple, les numéros de téléphone sont dans les colonnes A, B, C, D
et le résultat de la concaténation s'affiche en colonne E
'--------------------------------------------
Sub test()
Dim R As Range, C As Range, T As String
With Worksheets("Feuil1")
With .Range("A1:D5")
For Each R In .Rows
For Each C In R.Cells
T = T & Format(C.Value, "##"" ""##"" ""##"" ""##"" ")
Next
If T <> "" Then
.Range("E" & R.Row) = Left(T, Len(T) - 3)
T = ""
End If
Next
End With
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'--------------------------------------------
Je ne suis pas du tout aguerri aux boucles imbriquées et bien évidement dans l'adaptation, comme c'est souvent le cas c'est l'interface entre le siège et le clavier qui merdouille...
J'ai modifié ainsi votre macro mais le résultat obtenu n'est pas celui attendu et je ne comprend pas du tout pourquoi 1°) cela met les résultats en colonne N et pas en colonne I. 2°) si je mets F2 à la place de F1, les consignes sont bien faites sur les lignes demandées (F2 à Hlg) mais l'ensemble des résultats est alors décalé d'une ligne.
Sub test() Dim R As Range, C As Range, T As String Dim lg As Integer lg = ActiveWorkbook.Sheets("Feuil5").Range("A65536").End(xlUp)(1).Row
With Worksheets("Feuil5") With .Range("F1:H" & lg) For Each R In .Rows For Each C In R.Cells T = T & Format(C.Value, "00"" ""##"" ""##"" ""##"" ""##"" ") Next If T <> "" Then .Range("I" & R.Row) = Left(T, Len(T) - 3) T = "" End If Next End With End With Application.EnableEvents = True Application.ScreenUpdating = True End Sub
Merci d'avance pour l'éclairage de ma lanterne. Daniel
Le 21/04/2014 13:12, MichD a écrit :
Bonjour,
Essaie comme ceci :
Tu adaptes le nom de la feuille et la plage de cellules. Dans l'exemple, les numéros de téléphone sont dans les colonnes A, B, C, D et le résultat de la concaténation s'affiche en colonne E '-------------------------------------------- Sub test() Dim R As Range, C As Range, T As String
With Worksheets("Feuil1") With .Range("A1:D5") For Each R In .Rows For Each C In R.Cells T = T & Format(C.Value, "##"" ""##"" ""##"" ""##"" ") Next If T <> "" Then .Range("E" & R.Row) = Left(T, Len(T) - 3) T = "" End If Next End With End With Application.EnableEvents = True Application.ScreenUpdating = True End Sub '--------------------------------------------
MichD
Essaie comme ceci :
Colle cette procédure dans un module standard :
'-------------------------------------------------------- Sub test() Dim R As Range, C As Range, T As String Dim DerLig As Long
With Worksheets("Feuil5") With .Range("F:H") DerLig = .Find("*", LookIn:=xlValues, _ SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row End With With .Range("F1:H" & DerLig) For Each R In .Rows For Each C In R.Cells T = T & Format(C.Value, "##"" ""##"" ""##"" ""##"" ") Next If T <> "" Then .Range("E" & R.Row) = Left(T, Len(T) - 3) T = "" End If Next End With End With Application.EnableEvents = True Application.ScreenUpdating = True End Sub '--------------------------------------------------------
"Daniel" a écrit dans le message de groupe de discussion : 5355fb9a$0$3631$
Bonjour Michel et bonjour à toutes et à tous,
Je ne suis pas du tout aguerri aux boucles imbriquées et bien évidement dans l'adaptation, comme c'est souvent le cas c'est l'interface entre le siège et le clavier qui merdouille...
J'ai modifié ainsi votre macro mais le résultat obtenu n'est pas celui attendu et je ne comprend pas du tout pourquoi 1°) cela met les résultats en colonne N et pas en colonne I. 2°) si je mets F2 à la place de F1, les consignes sont bien faites sur les lignes demandées (F2 à Hlg) mais l'ensemble des résultats est alors décalé d'une ligne.
Sub test() Dim R As Range, C As Range, T As String Dim lg As Integer lg = ActiveWorkbook.Sheets("Feuil5").Range("A65536").End(xlUp)(1).Row
With Worksheets("Feuil5") With .Range("F1:H" & lg) For Each R In .Rows For Each C In R.Cells T = T & Format(C.Value, "00"" ""##"" ""##"" ""##"" ""##"" ") Next If T <> "" Then .Range("I" & R.Row) = Left(T, Len(T) - 3) T = "" End If Next End With End With Application.EnableEvents = True Application.ScreenUpdating = True End Sub
Merci d'avance pour l'éclairage de ma lanterne. Daniel
Le 21/04/2014 13:12, MichD a écrit :
Bonjour,
Essaie comme ceci :
Tu adaptes le nom de la feuille et la plage de cellules. Dans l'exemple, les numéros de téléphone sont dans les colonnes A, B, C, D et le résultat de la concaténation s'affiche en colonne E '-------------------------------------------- Sub test() Dim R As Range, C As Range, T As String
With Worksheets("Feuil1") With .Range("A1:D5") For Each R In .Rows For Each C In R.Cells T = T & Format(C.Value, "##"" ""##"" ""##"" ""##"" ") Next If T <> "" Then .Range("E" & R.Row) = Left(T, Len(T) - 3) T = "" End If Next End With End With Application.EnableEvents = True Application.ScreenUpdating = True End Sub '--------------------------------------------
Essaie comme ceci :
Colle cette procédure dans un module standard :
'--------------------------------------------------------
Sub test()
Dim R As Range, C As Range, T As String
Dim DerLig As Long
With Worksheets("Feuil5")
With .Range("F:H")
DerLig = .Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End With
With .Range("F1:H" & DerLig)
For Each R In .Rows
For Each C In R.Cells
T = T & Format(C.Value, "##"" ""##"" ""##"" ""##"" ")
Next
If T <> "" Then
.Range("E" & R.Row) = Left(T, Len(T) - 3)
T = ""
End If
Next
End With
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'--------------------------------------------------------
"Daniel" a écrit dans le message de groupe de discussion :
5355fb9a$0$3631$426a74cc@news.free.fr...
Bonjour Michel et bonjour à toutes et à tous,
Je ne suis pas du tout aguerri aux boucles imbriquées et bien évidement
dans l'adaptation, comme c'est souvent le cas c'est l'interface entre le
siège et le clavier qui merdouille...
J'ai modifié ainsi votre macro mais le résultat obtenu n'est pas celui
attendu et je ne comprend pas du tout pourquoi
1°) cela met les résultats en colonne N et pas en colonne I.
2°) si je mets F2 à la place de F1, les consignes sont bien faites sur
les lignes demandées (F2 à Hlg) mais l'ensemble des résultats est alors
décalé d'une ligne.
Sub test()
Dim R As Range, C As Range, T As String
Dim lg As Integer
lg = ActiveWorkbook.Sheets("Feuil5").Range("A65536").End(xlUp)(1).Row
With Worksheets("Feuil5")
With .Range("F1:H" & lg)
For Each R In .Rows
For Each C In R.Cells
T = T & Format(C.Value, "00"" ""##"" ""##"" ""##""
""##"" ")
Next
If T <> "" Then
.Range("I" & R.Row) = Left(T, Len(T) - 3)
T = ""
End If
Next
End With
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Merci d'avance pour l'éclairage de ma lanterne.
Daniel
Le 21/04/2014 13:12, MichD a écrit :
Bonjour,
Essaie comme ceci :
Tu adaptes le nom de la feuille et la plage de cellules.
Dans l'exemple, les numéros de téléphone sont dans les colonnes A, B, C, D
et le résultat de la concaténation s'affiche en colonne E
'--------------------------------------------
Sub test()
Dim R As Range, C As Range, T As String
With Worksheets("Feuil1")
With .Range("A1:D5")
For Each R In .Rows
For Each C In R.Cells
T = T & Format(C.Value, "##"" ""##"" ""##"" ""##"" ")
Next
If T <> "" Then
.Range("E" & R.Row) = Left(T, Len(T) - 3)
T = ""
End If
Next
End With
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'--------------------------------------------
With Worksheets("Feuil5") With .Range("F:H") DerLig = .Find("*", LookIn:=xlValues, _ SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row End With With .Range("F1:H" & DerLig) For Each R In .Rows For Each C In R.Cells T = T & Format(C.Value, "##"" ""##"" ""##"" ""##"" ") Next If T <> "" Then .Range("E" & R.Row) = Left(T, Len(T) - 3) T = "" End If Next End With End With Application.EnableEvents = True Application.ScreenUpdating = True End Sub '--------------------------------------------------------
"Daniel" a écrit dans le message de groupe de discussion : 5355fb9a$0$3631$
Bonjour Michel et bonjour à toutes et à tous,
Je ne suis pas du tout aguerri aux boucles imbriquées et bien évidement dans l'adaptation, comme c'est souvent le cas c'est l'interface entre le siège et le clavier qui merdouille...
J'ai modifié ainsi votre macro mais le résultat obtenu n'est pas celui attendu et je ne comprend pas du tout pourquoi 1°) cela met les résultats en colonne N et pas en colonne I. 2°) si je mets F2 à la place de F1, les consignes sont bien faites sur les lignes demandées (F2 à Hlg) mais l'ensemble des résultats est alors décalé d'une ligne.
Sub test() Dim R As Range, C As Range, T As String Dim lg As Integer lg = ActiveWorkbook.Sheets("Feuil5").Range("A65536").End(xlUp)(1).Row
With Worksheets("Feuil5") With .Range("F1:H" & lg) For Each R In .Rows For Each C In R.Cells T = T & Format(C.Value, "00"" ""##"" ""##"" ""##"" ""##"" ") Next If T <> "" Then .Range("I" & R.Row) = Left(T, Len(T) - 3) T = "" End If Next End With End With Application.EnableEvents = True Application.ScreenUpdating = True End Sub
Merci d'avance pour l'éclairage de ma lanterne. Daniel
Le 21/04/2014 13:12, MichD a écrit :
Bonjour,
Essaie comme ceci :
Tu adaptes le nom de la feuille et la plage de cellules. Dans l'exemple, les numéros de téléphone sont dans les colonnes A, B, C, D et le résultat de la concaténation s'affiche en colonne E '-------------------------------------------- Sub test() Dim R As Range, C As Range, T As String
With Worksheets("Feuil1") With .Range("A1:D5") For Each R In .Rows For Each C In R.Cells T = T & Format(C.Value, "##"" ""##"" ""##"" ""##"" ") Next If T <> "" Then .Range("E" & R.Row) = Left(T, Len(T) - 3) T = "" End If Next End With End With Application.EnableEvents = True Application.ScreenUpdating = True End Sub '--------------------------------------------
MichD
Désolé, j'ai omis de modifier où les données doivent s'inscrire dans la nouvelle macro.
Modifie cette ligne de code : .Range("E" & R.Row) = Left(T, Len(T) - 3)
Pour .Range("i" & R.Row) = Left(T, Len(T) - 3)
Essaie comme ceci :
Colle cette procédure dans un module standard :
'-------------------------------------------------------- Sub test() Dim R As Range, C As Range, T As String Dim DerLig As Long
With Worksheets("Feuil5") With .Range("F:H") DerLig = .Find("*", LookIn:=xlValues, _ SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row End With With .Range("F1:H" & DerLig) For Each R In .Rows For Each C In R.Cells T = T & Format(C.Value, "##"" ""##"" ""##"" ""##"" ") Next If T <> "" Then .Range("i" & R.Row) = Left(T, Len(T) - 3) T = "" End If Next End With End With Application.EnableEvents = True Application.ScreenUpdating = True End Sub '--------------------------------------------------------
Désolé, j'ai omis de modifier où les données doivent s'inscrire dans la
nouvelle macro.
Modifie cette ligne de code :
.Range("E" & R.Row) = Left(T, Len(T) - 3)
Pour
.Range("i" & R.Row) = Left(T, Len(T) - 3)
Essaie comme ceci :
Colle cette procédure dans un module standard :
'--------------------------------------------------------
Sub test()
Dim R As Range, C As Range, T As String
Dim DerLig As Long
With Worksheets("Feuil5")
With .Range("F:H")
DerLig = .Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End With
With .Range("F1:H" & DerLig)
For Each R In .Rows
For Each C In R.Cells
T = T & Format(C.Value, "##"" ""##"" ""##"" ""##"" ")
Next
If T <> "" Then
.Range("i" & R.Row) = Left(T, Len(T) - 3)
T = ""
End If
Next
End With
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'--------------------------------------------------------
With Worksheets("Feuil5") With .Range("F:H") DerLig = .Find("*", LookIn:=xlValues, _ SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row End With With .Range("F1:H" & DerLig) For Each R In .Rows For Each C In R.Cells T = T & Format(C.Value, "##"" ""##"" ""##"" ""##"" ") Next If T <> "" Then .Range("i" & R.Row) = Left(T, Len(T) - 3) T = "" End If Next End With End With Application.EnableEvents = True Application.ScreenUpdating = True End Sub '--------------------------------------------------------
Daniel
Malheureusement cela ne change rien le résultat est toujours en colonne N. Et si je remplace : With .Range("F1:H" & DerLig) par : With .Range("F2:H" & DerLig) pour ne pas concatener la ligne des titres, les résultats sont décalés d'une ligne. Ci-joint le type même de fichier utilisé.
With Worksheets("Feuil5") With .Range("F:H") DerLig = .Find("*", LookIn:=xlValues, _ SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row End With With .Range("F1:H" & DerLig) For Each R In .Rows For Each C In R.Cells T = T & Format(C.Value, "##"" ""##"" ""##"" ""##"" ") Next If T <> "" Then .Range("i" & R.Row) = Left(T, Len(T) - 3) T = "" End If Next End With End With Application.EnableEvents = True Application.ScreenUpdating = True End Sub '--------------------------------------------------------
Malheureusement cela ne change rien le résultat est toujours en colonne N.
Et si je remplace : With .Range("F1:H" & DerLig)
par : With .Range("F2:H" & DerLig) pour ne pas concatener la ligne des
titres, les résultats sont décalés d'une ligne.
Ci-joint le type même de fichier utilisé.
http://cjoint.com/?0Dwsqf2hyB4
Merci pour votre attention et votre patience.
Daniel
Le 22/04/2014 13:09, MichD a écrit :
Désolé, j'ai omis de modifier où les données doivent s'inscrire dans la
nouvelle macro.
Modifie cette ligne de code :
.Range("E" & R.Row) = Left(T, Len(T) - 3)
Pour
.Range("i" & R.Row) = Left(T, Len(T) - 3)
Essaie comme ceci :
Colle cette procédure dans un module standard :
'--------------------------------------------------------
Sub test()
Dim R As Range, C As Range, T As String
Dim DerLig As Long
With Worksheets("Feuil5")
With .Range("F:H")
DerLig = .Find("*", LookIn:=xlValues, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
End With
With .Range("F1:H" & DerLig)
For Each R In .Rows
For Each C In R.Cells
T = T & Format(C.Value, "##"" ""##"" ""##"" ""##"" ")
Next
If T <> "" Then
.Range("i" & R.Row) = Left(T, Len(T) - 3)
T = ""
End If
Next
End With
End With
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
'--------------------------------------------------------
Malheureusement cela ne change rien le résultat est toujours en colonne N. Et si je remplace : With .Range("F1:H" & DerLig) par : With .Range("F2:H" & DerLig) pour ne pas concatener la ligne des titres, les résultats sont décalés d'une ligne. Ci-joint le type même de fichier utilisé.
With Worksheets("Feuil5") With .Range("F:H") DerLig = .Find("*", LookIn:=xlValues, _ SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row End With With .Range("F1:H" & DerLig) For Each R In .Rows For Each C In R.Cells T = T & Format(C.Value, "##"" ""##"" ""##"" ""##"" ") Next If T <> "" Then .Range("i" & R.Row) = Left(T, Len(T) - 3) T = "" End If Next End With End With Application.EnableEvents = True Application.ScreenUpdating = True End Sub '--------------------------------------------------------
