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