среда, 9 августа 2017 г.

Макрос в MS Excel для вычисления минут

Рассмотрим создание макроса для MS Excel на VBA. Достаточно запустить готовый файл temp.xls и включить поддержку макросов, либо прописать рассмотренный ниже код в другом документе Excel. При этом этот документ должен быть запущен для использования процедур, содержащихся в нем.

В temp.xls уже содержатся две процедуры для использования. Скачать тут.

Sub MinuteToB -  Выделяем колонку "С", при этом в колонку "В" будут внесены данные в формате (00-хх), где хх - это минуты.

Sub DifMinToC - Выделяем колонку "В", при этом в колонку "С" будут внесена разница в минутах. Например, в "В" = (10-80), тогда в "С" = 70.
Sub MinuteToB()
'номер первой выделенной ячейки
Dim MyFirstRow As Long

With ActiveSheet
Set cur_range = Selection
cur_range.Activate
' Debug.Print cur_range.Address
' Debug.Print Selection.Row
MyFirstRow = Selection.Row
'уменьшаем на единицу, потому что будем прибавлять каждый раз с первой ячейки из скопированного диапазона
MyFirstRow = MyFirstRow - 1
For x = 1 To cur_range.Rows.Count
If Len(cur_range(x, 1)) > 1 Then
ActiveWorkbook.ActiveSheet.Range("B" & CStr(MyFirstRow + x)).Value = "(00-" & cur_range(x, 1) & ")"
Else
ActiveWorkbook.ActiveSheet.Range("B" & CStr(MyFirstRow + x)).Value = "(00-0" & cur_range(x, 1) & ")"
End If
Next x
End With


End Sub



Sub DifMinToC()

'номер первой выделенной ячейки
Dim MyFirstRow As Long
With ActiveSheet
Set cur_range = Selection
cur_range.Activate
' Debug.Print cur_range.Address
' Debug.Print Selection.Row
MyFirstRow = Selection.Row
'уменьшаем на единицу, потому что будем прибавлять каждый раз с первой ячейки из скопированного диапазона
MyFirstRow = MyFirstRow - 1
For x = 1 To cur_range.Rows.Count
ActiveWorkbook.ActiveSheet.Range("C" & CStr(MyFirstRow + x)).Value = Dif(CStr(cur_range(x, 1)))
Next x
End With

End Sub



'вычисляем в ней разницу минут из выражения, например, (20-100)
Function Dif(text As String) As String
Dim sym As Long
'первое число
Dim First As String
'второе число
Dim Temp As String
'будет True когда нашли первое число
Dim Flag As Boolean

Flag = False
First = ""

For sym = 1 To Len(text)
'если текущий символ цифра
If InStr(1, "0123456789", Mid$(text, sym, 1), 1) <> 0 Then
Temp = Temp & Mid$(text, sym, 1)
Else
'для первого числа
If (Temp <> "") And (Flag = False) Then
Flag = True
First = Temp
Temp = ""
End If
End If
Next sym
'второе число осталось после в Temp

Dif = CStr(CInt(Temp) - CInt(First))

End Function




 

 

 

Комментариев нет:

Отправить комментарий