Помогите доработать макрос
мне нужно, чтобы в таблице можно было выбрать различные ячейки формата
1,23
1,30
1,894
и чтобы при активации макроса стало так:
1,23*
1,30*
1,89*
по сути он округляет, а потом преобразует в текст выделенные диапазоны, но выглядит это слишком громоздко и хотелось, чтобы это распространялось не на диапазон, а на различные выделенные ячейки.
| Код |
|---|
Sub Диапазон_2()
'определяем координаты выделенного диапазона
lRow = Selection.Row 'номер первой строки
lLastRow = Selection.Row + Selection.Rows.Count - 1 'номер последней строки
lCol = Selection.Column 'номер первого столбца
lLastCol = Selection.Column + Selection.Columns.Count - 1 'номер последнего столбца
Dim a1, b1 As Integer
For a1 = lCol To lLastCol
For b1 = lRow To lLastRow
Dim ravno, cont
'проверка на наличие формулы в ячейке, и обрезание содержимого на знак равно, в случае если формула есть
ravno = Left(Cells(b1, a1).Formula, 1)
If ravno Like "=" Then
cont = Right(Cells(b1, a1).Formula, Len(Cells(b1, a1).Formula) - 1)
Else
cont = Cells(b1, a1).Formula
End If
'проверка на наличие формулы округления в ячейке
If cont Like "*ROUND*" Or cont Like "*CEILING*" Or cont Like "*FLOOR*" Then
MsgBox "Уже есть округление"
Else
Cells(b1, a1).Formula = "=TEXT(ROUND(" & cont & ",2),""0,00"")&""*"""
End If
Next b1
Next a1
Dim smallrng As Range
For Each smallrng In Selection.Areas
smallrng.Value = smallrng.Value
Next smallrng
End Sub |
