Сокращение после запятой

[Romuald]

Добрый день!
Подскажите, пожалуйста : возникла необходимость в такой фишке
Колонка с цифрами и ее надо во как сделать --- поставить критерий
если после запятой к примеру цифра 3 то целое число плюс 1, если меньше 3 то равно целому, но так как иногда надо менять критерий
и после запятой может быть любая цифирь и иногда такая же ...... по второй цифре после запятой
Помогите с макросом:
1 Выбираем колонку или диапазон
2 Врубаем макрос и задаем критерий а) по какой цифре после запятой
б) после какой цифры идет +1
заранее спасибо

[Pavel55]

Точно не знаю, посмотрите

Sub Test()
Dim iRange, iCell As Range
Dim iNumber, PlusOneNumber As Long

Set iRange = Selection.Cells
    If iRange.Cells.Count = 1 Then
        MsgBox "Выделите диапазон ячеек!"
        Exit Sub
    End If
    'по какой цифре после запятой
    iNumber = Application.InputBox("По какой цифре после запятой?", "Вопросик", 2)
    If iNumber = 0 Then
        MsgBox "Вы не ввели данные!", vbExclamation, "Ошибка"
        Exit Sub
    End If
    'после какой цифры идет +1
    PlusOneNumber = Application.InputBox("После какой цифры идет +1?", "Вопросик", 3)
    If PlusOneNumber = 0 Then
        MsgBox "Вы не ввели данные!", vbExclamation, "Ошибка"
        Exit Sub
    End If
    
    For Each iCell In iRange
        If IsNumeric(iCell) Then
            If InStr(1, iCell, ",") > 0 Then
                If Mid(iCell, iNumber + 1, 1) = PlusOneNumber Then iCell = iCell + 1
                If Mid(iCell, iNumber + 1, 1) < PlusOneNumber Then iCell = WorksheetFunction.Round(iCell, 0)
            End If
        End If
    Next
    MsgBox "Массив данных обработан!", vbInformation, "Конец"
End Sub

[Romuald]

Поставил, все нормально,спрашивает критерии , но действий никаких

[Romuald]

Вот сам файл

[Pavel55]

хм, ну, я не знаю... Я выделяю ячейки B1:B10 в вашем файле, запускаю макрос, нажимаю 2 раза "ОК" и он мне эти ячейки обрабатывает. Вот что получается
1,00
1,00
1,00
1,00
2,30
2,35
1,40
1,45
1,50
1,55

P.S. желательно, чтобы все числа былы сохранены в числофот формате, а не как текст (т.е. чтобы не было зелёненьких треугольничков у ячейки). Т.к. в коде обрабатываются ячейки с числом.

P.S.S. Я неправильно объявил переменные в этом макросе, поправьте там

Dim iRange As Range, iCell As Range
Dim iNumber As Long, PlusOneNumber As Long

[Romuald]

Пробую , но......
Вот какие данные хотелось бы увидеть

[Pavel55]

надо подумать) Может нам Pashulka поможет ? )

[Pavel55]

Посмотрите

Sub Test()
Dim iRange As Range, iCell As Range
Dim iNumber  As Long, PlusOneNumber As Long

Set iRange = Selection.Cells
    If iRange.Cells.Count = 1 Then
        MsgBox "Videlite diapazon jacheek!"
        Exit Sub
    End If
    'Po kakoi cifre posle zapjatoi
    iNumber = Application.InputBox("Po kakoi cifre posle zapjatoi?", "Voprosik", 2)
    If iNumber = 0 Then
        MsgBox "Vi ne vveli dannie!", vbExclamation, "Oshibka"
        Exit Sub
    End If
    'posle kakoi cifri idet+1
    PlusOneNumber = Application.InputBox("Posle kakoi cifri idet +1?", "Voprosik", 3)
    If PlusOneNumber = 0 Then
        MsgBox "Vi ne vveli dannie!", vbExclamation, "Oshibka"
        Exit Sub
    End If
    For Each iCell In iRange
        If IsNumeric(iCell) Then
            If InStr(1, iCell, ",") > 0 Then
                '1
                If iNumber = 1 Then
                    If Mid(iCell, InStr(1, iCell, ",") + iNumber, 1) < PlusOneNumber Then iCell = WorksheetFunction.RoundDown(iCell, 0)
                    If Mid(iCell, InStr(1, iCell, ",") + iNumber, 1) = PlusOneNumber Then iCell = WorksheetFunction.RoundUp(iCell, 0)
                '2
                ElseIf iNumber = 2 Then
                    iCell = WorksheetFunction.RoundUp(iCell, 1)
                End If
            End If
        End If
    Next
    MsgBox "Massiv dannih obrabotan!", vbInformation, "VSJO!!!"
End Sub

[Romuald]

Не ..... не идет !!!!!!!

[Romuald]

Не ..... не идет !!!!!!!