Rapport de message :*
 

Re: Correction d'adresse postale dans une cellule

Titre du sujet : Re: Correction d'adresse postale dans une cellule
par Eric le 08/03/2014 20:09:33

Bonsoir à tous
Bonsoir Althéa

Si j'ai bien compris ton problème, je te propose une Sub que tu lanceras une fois que tu auras tout "saisi".

Il te suffit de sélectionner les cellules (qui doivent être dans la même colonne) à vérifier et à lancer la procédure.

Option Explicit

Sub Maj_Min()
Dim tbl As String
Dim tbl_cellule As Variant
Dim tablo()
Dim a As Integer, i As Integer
Dim ma_cell As String
Dim ma_col As String
Dim derlign As Integer
Dim premlign As Integer

If ActiveCell = "" Then MsgBox "Sélectionner les cellules à corriger": Exit Sub
tablo = Array("De", "Du", "Des", "Le", "La", "À", "En", "Au", "Bis", "Ter", "D'", "L'", "Aux", "Rue", "Avenue", "Boulevard", "Place", "Allée")
tbl = Selection.AddressLocal(RowAbsolute:=False, ColumnAbsolute:=False)

premlign = Trim(Val(Mid(Split(tbl, ":")(0), 2, Len(Split(tbl, ":")(0)) - 2 + 1)))
If InStr(tbl, ":") <> 0 Then derlign = Val(Mid(Split(tbl, ":")(1), 2, Len(Split(tbl, ":")(1)) - 2 + 1)) Else derlign = premlign
ma_col = Mid(Split(tbl, ":")(0), 1, Len(Split(tbl, ":")(0)) - Len(CStr(premlign)))

For i = premlign To derlign
    tbl_cellule = Split(Range(ma_col & i), " ")
    For a = 0 To UBound(tbl_cellule, 1)
        If Not IsError(Application.Match(tbl_cellule(a), tablo, 0)) = True Then
            ma_cell = ma_cell & LCase(tbl_cellule(a)) & " "
        Else
            If a = 0 Then
                ma_cell = tbl_cellule(a) & " "
            Else
                ma_cell = ma_cell & tbl_cellule(a) & " "
            End If
        End If
    Next a
    Range(ma_col & i) = Trim(ma_cell)
    ma_cell = ""
Next i

End Sub

Dis nous 

Eric