XL 2010 Macro VBA Excel (Doublon,SansAccents,Maj,Min,Nompropre,Espaces superflus)

[Virginie17d]

 

[patricktoulon]

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

 

[Virginie17d]

non 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

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...Merci

 

[Virginie17d]

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

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 :
=MAJUSCULE(CONCATENER(G2;".";H2;"/SOCIETE"))

 

[patricktoulon]

ben pourquoi tu continue pas avec formule en ajoutant suprspace dans ta formule

 

[patricktoulon]

tiens en attendant voila la suprespace rectifié que l'on peut mettre ajours en ajoutant les exepression dans l'array

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

 

[Virginie17d]

ben pourquoi tu continue pas avec formule en ajoutant suprspace dans ta formule

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 superspace

 

[patricktoulon]

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 ????) 😉

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

 

[Virginie17d]

B

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 ????) 😉

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

Non tu as parfaitement compris quant au code, je ne suis pas au stade de le comprendre en entier, j'ai repris un exemple trouver sur internet et j'ai modulé sur mes colonnes

 

[patricktoulon]

ok donc voila

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

j'ai modifier aussi celle dans le module thisworkbook qui plante si on vide plusieur lignes dans "C " en meme temps

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

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

voila
je pense que l'on a tout vu
😉

 

[patricktoulon]

allez le thisworkbook on nettoie encore

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

cette fois ci on est bon

bonne route 😉

 

[Virginie17d]

ok donc voila

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

j'ai modifier aussi celle dans le module thisworkbook qui plante si on vide plusieur lignes dans "C " en meme temps

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

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

voila
je pense que l'on a tout vu
😉

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.
Un Grand merciiiiiiii

 

[patricktoulon]

aH t'inquiet j'en ai une grande et une moyenne a la maison elle ne me paraissent pas trop malheureuses 😀 😀 😀

 

[patricktoulon]

je vais m’attaquer a ma découverte maintenant 😀😉

 

[patricktoulon]

pour les format téléphone utilise le formatage cellule
sinon je t'en fait une en vba 😉😀😀😀

 

[patricktoulon]

au cas ou tu fait une betise voici l'archive