Есть макрос который позволяет быстрее вводить даты и время - без написания разделительных символов между числами, т.е., пишем: 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
Макрос состоит из 2 блоков, первый отвечает за даты, второй за время, в каждом блоке указывается диапазон для работы макроса в нужных столбцах, т.е. нужен третий блок только для процентов (т.е. в указаном диапазоне ячеек будут вводится только проценты и макрос может быть уверен что введенное число нужно преобразовать в процент).
Дробных чисел будет всегда не больше 2, т.е. 2 крайние цифры справа можно всегда считать дробными. Предшествующие же цифры будут целым числом процентов, 1 это или 20 или 100, готовые данные будут выглядеть так: 1.00% -20.16% 123.84% 9999.55%
Ну да, правильно будет говорить десятичных знаков, а не дробных чисел. А 7 одной цифрой, это если возможно (да, сейчас подумала над логикой и наверное так не получится, только если будет правило - если указана только одна или две цифры - считать их целым числом, для трех цифр уже не подойдет), можно конечно обойтись и без этого
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
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
ivanok_v2 написал: alexasavel ,на вашем файле работаетпопробуйте руками внести данные в колонке C
И правда, удалила все, ввела заново, заработало, большое спасибо! (в первый раз делала точно также, но результаты были на картинке). Присутствует какой-то фантомный глюк, который был сразу, но я не стала про него писать, иногда пишешь 100, макрос преобразует это в 100.00% а не в 1.00% Сейчас первые 4 строчки преобразовались правильно, а остальные нет... странно, вы не знаете с чем это может быть связано?
Upd: вобщем если очистить ячейку с неправильно преобразованным значением и вписать заново, то преобразует нормально, в первый же раз нет...
Выставила процентный формат для столбца, пока все работает, буду тестить, спасибо!
Ну похоже дело было в формате ячеек, при общем формате преобразовывало неправильно, после макроса формат ячейки меняется на процентный и если очистить ячейку и ввести цифры снова, результат верный. Изначальная установка процентного формата для столбца решает эту проблему.