C'est Parfait !Ca devrait être suffisant, ce cas est moins fréquent que les espaces avant/après les valeurs. Et un de moins...Merci...Mercinon il te manque 2 replace
cell.Value = Application.Trim(Replace(Replace(Replace(Replace(cell.Value, " -", "-"), "- ", "-"), " /", "/"), "/ ", "/"))
apres si tu a plus de truc a faire pour simplifier peut etre faudra il faire une sousboucle sur un array d'expression
Alors sa remplace ma formule de ma concatenation.Le but est de créer des identifiants unique, je prends donc la nomenclature NOM.PRENOM/SOCIETE sachant que la société est une variable, d'un fichier à l'autre je devrais modifier mon Macro (sauf si solution autre). La particularité de ces cellules c'est qu'elles doivent être en majuscule et sans espaces ni caractères spéciaux y compris "-" ou " ' " donc JEAN-LUC devient JEANLUC et L'EMPEREUR devient LEMPEREUR. l'avantage les colonnes sont toujours au même endroit et le résultat également dans la même colonne. Valeur NOM en "G" Prénom en "H" et résultat en colonne "C". La formule Excel que j'utilise est la suivante :passons a concat
c'est quoi le but ???
concaténer le nom et prenom de chaque ligne dans la cellule en colonne 'C" de la même ligne ???
Sub espacessuperflus_total()
Dim cell As Range, expression, Sp$
Sp = " "
expression = Array("/", "-") ' ajouter des expressions ici sans les espaces au besoins
For Each cell In ActiveSheet.UsedRange
For c = 0 To UBound(expression)
cell.Value = Application.Trim(Replace(Replace(cell.Value, Sp & expression(c), expression(c)), expression(c) & Sp, expression(c)))
Next
Next
End Sub
Oui c'est une idée, je vais essayer, par contre elle n'est pas correcte car dans mon fichier tu vois qu'il n'y a pas de valeur de la ligne 2 à 6, impossible d'y rémédier. la valeur dans la cellule C4 à été ajouté manuellement pour l'ex du superspaceben pourquoi tu continue pas avec formule en ajoutant suprspace dans ta formule
Sub Concat()
Dim conc(), n&, i&
With ActiveSheet
'comme on commence le tableau en ligne 1 pas la peine de se casser la tete
n = ActiveSheet.UsedRange.Rows.Count
ReDim conc(1 To i, 1)
For i = 2 To n
If .Cells(i, 7) <> "" Or .Cells(i, 8) <> "" Then
conc(i - 2, 1) = Trim(.Cells(i, 7) & "." & .Cells(i, 8)) & "/GLOBEO" 'modifier le nom de l'entité avant de lancer
End If
Next i
.Cells(6, 3).Resize(i - 1).Value = conc?????????????????????
End With
End Sub
avant que je fasse une sottise
dit moi pourquoi tu start a la row 2 et tu recolle le tableau a la row 6 en ressizant a 1 cellule
a mon avis c'est une erreur
chaque ligne G et H doit être concaténé dans C ( me trompais-je ????)
VB:Sub Concat() Dim conc(), n&, i& With ActiveSheet 'comme on commence le tableau en ligne 1 pas la peine de se casser la tete n = ActiveSheet.UsedRange.Rows.Count ReDim conc(1 To i, 1) For i = 2 To n If .Cells(i, 7) <> "" Or .Cells(i, 8) <> "" Then conc(i - 2, 1) = Trim(.Cells(i, 7) & "." & .Cells(i, 8)) & "/GLOBEO" 'modifier le nom de l'entité avant de lancer End If Next i .Cells(6, 3).Resize(i - 1).Value = conc????????????????????? End With End Sub
Sub Concat()
Dim conc(), n&, i&, bool&
With ActiveSheet
'comme on commence le tableau en ligne 1 pas la peine de se casser la tete
n = ActiveSheet.UsedRange.Rows.Count
ReDim conc(1 To n)
For i = 2 To n
bool = Abs(.Cells(i, 7) <> "" And .Cells(i, 8) <> "")
If bool = 1 Then conc(i - 1) = Replace((.Cells(i, 7).Value & "." & .Cells(i, 8).Value) & "/EXCEL", " ", "") 'modifier le nom de l'entité avant de lancer
Next i
Application.EnableEvents = False
.Cells(2, 3).Resize(UBound(conc) + 1, 1).Value = Application.Transpose(conc)
Application.EnableEvents = True
End With
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim Montexte$
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
Montexte = Target.Value
Montexte2 = sansAccents(Montexte)
If Montexte2 <> Montexte Then
Application.EnableEvents = False
Target = Montexte2
Application.EnableEvents = True
End If
End Sub
Option Explicit
Sub Majuscules(): Traite_casse ("maj"): End Sub
Sub Miniuscules(): Traite_casse ("min"): End Sub
Sub NomPropre(): Traite_casse ("Npropre"): End Sub
Sub Traite_casse(Comment As String)
Dim cellule As Range
For Each cellule In Selection
Select Case Comment
Case "maj": cellule = UCase(cellule)
Case "Npropre": cellule = Application.Proper(cellule)
Case "min": cellule = LCase(cellule)
'Case Else: cellule = UCase(Left(cellule, 1)) & LCase(Mid(cellule, 2))??????????????
End Select
Next cellule
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Target = "" Then Exit Sub
Application.EnableEvents = False
Target.Text = sansAccents(Target.Text)
Application.EnableEvents = True
End Sub
C'est merveilleux, tu pourras au moins te vanter d'avoir rendu une femme heureuse aujourd'hui, :-D, j'ai tout testé et c'est super. j'ai plus qu'a me pencher sur les formats dates de naissances et téléphone, si j'ai un soucis je me permettrait d'ouvrir un nouvel échange.ok donc voila
j'ai modifier aussi celle dans le module thisworkbook qui plante si on vide plusieur lignes dans "C " en meme tempsVB:Sub Concat() Dim conc(), n&, i&, bool& With ActiveSheet 'comme on commence le tableau en ligne 1 pas la peine de se casser la tete n = ActiveSheet.UsedRange.Rows.Count ReDim conc(1 To n) For i = 2 To n bool = Abs(.Cells(i, 7) <> "" And .Cells(i, 8) <> "") If bool = 1 Then conc(i - 1) = Replace((.Cells(i, 7).Value & "." & .Cells(i, 8).Value) & "/EXCEL", " ", "") 'modifier le nom de l'entité avant de lancer Next i Application.EnableEvents = False .Cells(2, 3).Resize(UBound(conc) + 1, 1).Value = Application.Transpose(conc) Application.EnableEvents = True End With End Sub
VB:Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) Dim Montexte$ If Target.Count > 1 Then Exit Sub If Target = "" Then Exit Sub Montexte = Target.Value Montexte2 = sansAccents(Montexte) If Montexte2 <> Montexte Then Application.EnableEvents = False Target = Montexte2 Application.EnableEvents = True End If End Sub
du coup le module maj , min, etc...
réecrit aussi
voilaVB:Option Explicit Sub Majuscules(): Traite_casse ("maj"): End Sub Sub Miniuscules(): Traite_casse ("min"): End Sub Sub NomPropre(): Traite_casse ("Npropre"): End Sub Sub Traite_casse(Comment As String) Dim cellule As Range For Each cellule In Selection Select Case Comment Case "maj": cellule = UCase(cellule) Case "Npropre": cellule = Application.Proper(cellule) Case "min": cellule = LCase(cellule) 'Case Else: cellule = UCase(Left(cellule, 1)) & LCase(Mid(cellule, 2))?????????????? End Select Next cellule End Sub
je pense que l'on a tout vu