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

patricktoulon · 7 Mai 2020

re
a mince Bonjour Thierry je l'ai mis a jour avec la fonction eriiiic aussi

patricktoulon · 30 Avril 2020

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 · 30 Avril 2020

patricktoulon à dit:
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 · 30 Avril 2020

patricktoulon à dit:
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 · 30 Avril 2020

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

patricktoulon · 30 Avril 2020

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

VB:

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 · 30 Avril 2020

patricktoulon à dit:
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 · 30 Avril 2020

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

Virginie17d · 30 Avril 2020

B

patricktoulon à dit:
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

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 · 30 Avril 2020

ok donc voila

VB:

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

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

VB:

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 · 30 Avril 2020

allez le thisworkbook on nettoie encore

VB:

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 · 30 Avril 2020

patricktoulon à dit:

ok donc voila

VB:

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

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

VB:

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 · 30 Avril 2020

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

patricktoulon · 30 Avril 2020

je vais m’attaquer a ma découverte maintenant

patricktoulon · 30 Avril 2020

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

patricktoulon · 30 Avril 2020

au cas ou tu fait une betise voici l'archive

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

Virginie17d

XLDnaute Occasionnel

Pièces jointes

patricktoulon

patricktoulon

XLDnaute Barbatruc

Virginie17d

XLDnaute Occasionnel

Virginie17d

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Virginie17d

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

Virginie17d

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Virginie17d

XLDnaute Occasionnel

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

patricktoulon

XLDnaute Barbatruc

Pièces jointes

Discussions similaires