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

[Virginie17d]

 

[patricktoulon]

que l'on soit sur la meme longueur d'onde
Jean-Marc devient alors JEANMARC c'est bien ca

 

[Virginie17d]

que l'on soit sur la meme longueur d'onde
Jean-Marc devient alors JEANMARC c'est bien ca

Oui en faite c’est la même formule que caractères sauf qu’au lieu de ‘ = espace on ajoute ´ et - devient rien

 

[patricktoulon]

soit plus claire SVP
CA POUR MOI CA VEUX RIEN DIRE "sauf qu’au lieu de ‘ = espace on ajoute ´ et - devient rien "

 

[Virginie17d]

L’empereur jean marc devient LEMPEREUR JEANMARC

 

[Virginie17d]

Valérie durant devient VALERIE DURANT mais ces options sont uniquement lors de la concaténation

 

[patricktoulon]

ok

Sub Concat()
    Dim conc(), n&, i&, bool&, x1$, x2$
    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
            x1 = Trim(UCase(Replace(Replace(Replace(.Cells(i, 7).Value, "-", ""), "'", ""), " ", "")))
            x2 = Trim(UCase(Replace(Replace(Replace(.Cells(i, 8).Value, "-", ""), "'", ""), " ", "")))
            bool = Abs(x1 <> "" And x2 <> "")
            conc(i - 1) = (x1 & " " & x2) & "/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

 

[Virginie17d]

conc(i - 1) = (x1 & " " & x2) & "/EXCEL" 'modifier le nom de l'entité avant de lancer

Parfait, j'ai juste ajouté le "." entre x1 & x2 mais c'est parfait. Un grand merci de ton aide et je garde précieusement les fichiers sources

 

[patricktoulon]

re
petit correctif

Sub Concat()
    Dim conc(), n&, i&, bool&, x1$, x2$
    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
            x1 = Trim(UCase(Replace(Replace(Replace(.Cells(i, 7).Value, "-", ""), "'", ""), " ", "")))
            x2 = Trim(UCase(Replace(Replace(Replace(.Cells(i, 8).Value, "-", ""), "'", ""), " ", "")))
             trim(conc(i - 1) = (x1 & " " & x2) & "/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

 

[_Thierry]

Bonsoir Patrick

T'es sûr pour ton dernier post #83, j'ai appliqué la correction, et la collone C est radicalement vidée !! LOL

@+Thierry

 

[patricktoulon]

bonsoir Thierry
oui tu a raison
conc(i - 1) = trim((x1 & " " & x2) & "/EXCEL" ))
'c'est pour le cas ou une ou l'autre ou les deux(colonnes serait vides sur la ligne
des fois j'ai les clapets qui font roue libre

 

[patricktoulon]

maintenant est ce que tu en veux une classe de macro ?

mais une vraiment classe????

 

[_Thierry]

Re Patrick

C'est à moi que tu demande ça ? Je ne pense pas ! (Pourquoi une Class, pas une XLA ?
@+Thierry

 

[patricktoulon]

non pas un module classe
une macro qui a de la classe , du style ,de l'originalité

 

[_Thierry]

Ah oui je suis sûr que Viginie va adorer "décortiquer" une macro de classe , ça tombe bien elle est "à l'école"

@+Thierry

 

[patricktoulon]

allez tiens régale toi

selectionne une plage et lance testx en changeant l'argument

Function ChangeAllCellpropertiesInRange(ByRef RnG As Range, prop As String)
    Dim R As Variant, Addr

    With RnG
        Addr = "'" & .Parent.Name & "'!" & .Address
        Select Case UCase(prop)


            'formule non matricielles
        Case "LOWER", "UPPER", "PROPER", "APPTRIM":
            prop = Replace(UCase(prop), "APPTRIM", "TRIM")
            R = Evaluate("IF(ISTEXT(" & Addr & ")," & UCase(prop) & "(" & Addr & "),REPT(" & Addr & ",1))")

            'formules matricielle
        Case "LTRIM": R = Evaluate("IF(ISTEXT(" & Addr & "),MID(" & Addr & ",FIND(MID(TRIM(" & Addr & "),1,2)," & Addr & ",1),LEN(" & Addr & ")),REPT(" & Addr & ",1))")

             'nouvelle formule
        Case "RTRIM": R = Evaluate("IF(ISTEXT(" & Addr & "),LEFT(" & Addr & ",FIND(""§"",SUBSTITUTE(" & Addr & ",RIGHT(TRIM(" & Addr & "),1),""§"",LEN(" & Addr & ")-LEN(SUBSTITUTE(" & Addr & ",RIGHT(TRIM(" & Addr & "),1),""""))),1))," & Addr & ")")

        Case "TRIM": .Value = Evaluate("IF(ISTEXT(" & Addr & "),MID(" & Addr & ",FIND(MID(TRIM(" & Addr & "),1,2)," & Addr & ",1),LEN(" & Addr & ")),REPT(" & Addr & ",1))")
            R = Evaluate("IF(ISTEXT(" & Addr & "),MID(" & Addr & ",1,FIND(TRIM(RIGHT(SUBSTITUTE(TRIM(" & Addr & "), "" "", REPT("" "", 100)), 100))," & Addr & ",1)+LEN(TRIM(RIGHT(SUBSTITUTE(TRIM(" & Addr & "), "" "", REPT("" "", 100)), 100)))-1),REPT(" & Addr & ",1))")

        End Select
    End With

    ChangeAllCellpropertiesInRange = R
End Function


Sub testx()
    Dim DL, RnG As Range
         Set RnG = Selection
        'RnG.Parent.Activate
        RnG.Value = ChangeAllCellpropertiesInRange(RnG, "lower")    'majuscule ou minuscule l'argument de propertie
    
End Sub