Twitter iPhone pliant OnePlus 11 PS5 Disney+ Orange Livebox Windows 11

Concaténation et conservation du format tph

8 réponses
Avatar
Daniel
Bonjour à toute set à tous,

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

Range("A1").Select
End Sub

8 réponses

Avatar
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

Application.ScreenUpdating = False
Application.EnableEvents = False

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
'--------------------------------------------
Avatar
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

Application.ScreenUpdating = False
Application.EnableEvents = False

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

Application.ScreenUpdating = False
Application.EnableEvents = False

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
'--------------------------------------------
Avatar
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

Application.ScreenUpdating = False
Application.EnableEvents = False

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

Application.ScreenUpdating = False
Application.EnableEvents = False

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

Application.ScreenUpdating = False
Application.EnableEvents = False

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
'--------------------------------------------
Avatar
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

Application.ScreenUpdating = False
Application.EnableEvents = False

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
'--------------------------------------------------------
Avatar
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é.

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

Application.ScreenUpdating = False
Application.EnableEvents = False

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
'--------------------------------------------------------


Avatar
MichD
Ton classeur en retour :

http://cjoint.com/?DDwtg6lx9s8
Avatar
MichD
Oups! les numéros de téléphone ont 10 caractères.

Correction ici : http://cjoint.com/?DDwtrYZnnjB
Avatar
Daniel
Merci beaucoup Michel.
C'est impeccable et exactement ce que je souhaitais.


Le 22/04/2014 19:19, MichD a écrit :
Oups! les numéros de téléphone ont 10 caractères.

Correction ici : http://cjoint.com/?DDwtrYZnnjB