1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32
| 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))")
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),""""))))),REPT(" & .Address & ",1))")
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 test()
Dim DL, RnG As Range
With Sheets(1)
DL = .Cells(Rows.Count, 3).End(xlUp).Row
Set RnG = .Range("C2:C" & DL)
'RnG.Parent.Activate
RnG.Value = ChangeAllCellpropertiesInRange(RnG, "rTRIM") 'majuscule ou minuscule l'argument de propertie
End With
End Sub |
Partager