Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Макрос для быстрого ввода процентов
 
Здравствуйте

Есть макрос который позволяет быстрее вводить даты и время - без написания разделительных символов между числами, т.е., пишем:
080918 (или 80918) > макрос преобразует это число в дату > 08.09.2018
или
800 (или 0800) > макрос преобразует это число в время > 08:00

Это экономит много времени и сил, но можно ли сделать такое же для процентов? (десятичных знаков после точки будет всегда 2) т.е. пишем:
1246 > макрос преобразует это число в проценты > 12.46%
или
-700 > -7.00%
12306 > 123.06%
598700 > 5987.00%

Макрос состоит из 2 блоков, первый отвечает за даты, второй за время, в каждом блоке указывается диапазон для работы макроса в нужных столбцах, т.е. нужен третий блок только для процентов (в указаном диапазоне ячеек будут вводится только проценты и макрос может быть уверен что введенное число нужно преобразовать в процент).

Код макроса:
Код
Private Sub Worksheet_Change(ByVal Target As Range)
Dim vVal
Dim StrVal As String
Dim dDate As Date
 
    If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("A1:A999")) Is Nothing Then
        With Target
        StrVal = Format(.Text, "000000")
        If IsNumeric(StrVal) And Len(StrVal) = 6 Then
            Application.EnableEvents = False
            dDate = DateValue(Left(StrVal, 2) & "/" & Mid(StrVal, 3, 2) & "/" & Right(StrVal, 2))
            .NumberFormat = "dd/mm/yyyy"
            .Value = CDate(DateSerial(Year(dDate), Month(dDate), Day(dDate)))
           End If
        End With
    End If
     
    If Not Intersect(Target, Range("B1:B999")) Is Nothing Then
        With Target
            vVal = Format(.Value, "0000")
            If IsNumeric(vVal) And Len(vVal) = 4 Then
                Application.EnableEvents = False
                .Value = Left(vVal, 2) & ":" & Right(vVal, 2)
                .NumberFormat = "[hh]:mm"
            End If
        End With
     End If
     Application.EnableEvents = True
End Sub
Изменено: alexasavel - 8 Сен 2018 16:11:49
 
alexasavel, по какому признаку дата 0800(08:00) и число 7000(70%) алгоритм должен определить что ето время, а не %?
Изменено: ivanok_v2 - 8 Сен 2018 15:03:01
 
Макрос состоит из 2 блоков, первый отвечает за даты, второй за время, в каждом блоке указывается диапазон для работы макроса в нужных столбцах, т.е. нужен третий блок только для процентов (т.е. в указаном диапазоне ячеек будут вводится только проценты и макрос может быть уверен что введенное число нужно преобразовать в процент).
Изменено: alexasavel - 8 Сен 2018 15:08:51
 
123 - как макрос поймет: это 1,23% или 12,3%? А если у Вас перевыполение плана - 123%?
 
Дробных чисел будет всегда не больше 2, т.е. 2 крайние цифры справа можно всегда считать дробными.
Предшествующие же цифры будут целым числом процентов, 1 это или 20 или 100, готовые данные будут выглядеть так:
1.00%
-20.16%
123.84%
9999.55%
Изменено: alexasavel - 8 Сен 2018 15:25:01
 
Не путайте определения. "дробных чисел цифр"
Цитата
alexasavel написал: 2 крайние цифры справа можно всегда считать дробными.
0.75%, а  самом деле? А еще Вы хотели записывать 7% одной цифрой, а это 0,07%
 
Ну да, правильно будет говорить десятичных знаков, а не дробных чисел.
А 7 одной цифрой, это если возможно (да, сейчас подумала над логикой и наверное так не получится, только если будет правило - если указана только одна или две цифры - считать их целым числом, для трех цифр уже не подойдет), можно конечно обойтись и без этого  :)  
Изменено: alexasavel - 8 Сен 2018 15:32:55
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim vVal
    Dim StrVal As String
    Dim dDate As Date

    With Target

        If Target.Cells.Count > 1 Then Exit Sub
        Application.EnableEvents = False
        If Not Intersect(Target, Range("A1:A999")) Is Nothing Then
            StrVal = Format(.Text, "000000")
            If IsNumeric(StrVal) And Len(StrVal) = 6 Then
                dDate = DateValue(Left(StrVal, 2) & "/" & Mid(StrVal, 3, 2) & "/" & Right(StrVal, 2))
                .NumberFormat = "dd/mm/yyyy"
                .Value = CDate(DateSerial(Year(dDate), Month(dDate), Day(dDate)))
            End If
        End If
        If Not Intersect(Target, Range("B1:B999")) Is Nothing Then
            vVal = Format(.Value, "0000")
            If IsNumeric(vVal) And Len(vVal) = 4 Then
                .Value = Left(vVal, 2) & ":" & Right(vVal, 2)
                .NumberFormat = "[hh]:mm"
            End If
        End If
        If Not Intersect(Target, Range("C1:C999")) Is Nothing Then
            vVal = Format(.Value, "0000")
            If IsNumeric(vVal) And Len(vVal) = 4 Then
                .Value = vVal / 100
                .NumberFormat = "0.00%"
            End If
        End If
    End With
    Application.EnableEvents = True
End Sub

Код
Range("C1:C999")
В замен проставте свое значение.
Изменено: ivanok_v2 - 8 Сен 2018 15:36:30
 
Цитата
ivanok_v2 написал:
В замен проставте свое значение.
Сделала таблицу с примерами и получившимися результатами, ошибки залила красным)
makros.PNG (4.61 КБ)
 
Код
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim vVal
    Dim StrVal As String
    Dim dDate As Date
 
    With Target
 
        If Target.Cells.Count > 1 Then Exit Sub
        Application.EnableEvents = False
        If Not Intersect(Target, Range("A1:A999")) Is Nothing Then
            StrVal = Format(.Text, "000000")
            If IsNumeric(StrVal) And Len(StrVal) = 6 Then
                dDate = DateValue(Left(StrVal, 2) & "/" & Mid(StrVal, 3, 2) & "/" & Right(StrVal, 2))
                .NumberFormat = "dd/mm/yyyy"
                .Value = CDate(DateSerial(Year(dDate), Month(dDate), Day(dDate)))
            End If
        End If
        If Not Intersect(Target, Range("B1:B999")) Is Nothing Then
            vVal = Format(.Value, "0000")
            If IsNumeric(vVal) And Len(vVal) = 4 Then
                .Value = Left(vVal, 2) & ":" & Right(vVal, 2)
                .NumberFormat = "[hh]:mm"
            End If
        End If
        If Not Intersect(Target, Range("C1:C999")) Is Nothing Then
            vVal = .Value
            If IsNumeric(vVal) Then
                .Value = vVal / 100
                .NumberFormat = "0.00%"
            End If
        End If
    End With
    Application.EnableEvents = True
End Sub
 
Только по прежнему не учитываются десятичные знаки.
Приложила саму книгу.
makros2.PNG (4.9 КБ)
 
alexasavel,на вашем файле работает
попробуйте руками внести данные в колонке C
 
Цитата
ivanok_v2 написал:
alexasavel ,на вашем файле работаетпопробуйте руками внести данные в колонке C
И правда, удалила все, ввела заново, заработало, большое спасибо! (в первый раз делала точно также, но результаты были на картинке).
Присутствует какой-то фантомный глюк, который был сразу, но я не стала про него писать, иногда пишешь 100, макрос преобразует это в 100.00% а не в 1.00%
Сейчас первые 4 строчки преобразовались правильно, а остальные нет... странно, вы не знаете с чем это может быть связано?

Upd: вобщем если очистить ячейку с неправильно преобразованным значением и вписать заново, то преобразует нормально, в первый же раз нет...

Выставила процентный формат для столбца, пока все работает, буду тестить, спасибо!
mkr.PNG (6.24 КБ)
Изменено: alexasavel - 8 Сен 2018 17:20:11
 
alexasavel,давайте файл
 
Ну похоже дело было в формате ячеек, при общем формате преобразовывало неправильно, после макроса формат ячейки меняется на процентный и если очистить ячейку и ввести цифры снова, результат верный.
Изначальная установка процентного формата для столбца решает эту проблему.
 
8)  ;)  
Страницы: 1
Читают тему (гостей: 1)
Наверх