Страницы: 1
RSS
Конвертация информации в ячейке в другой вид (временные значения)
 
Граждане, доброго времени суток!
Помогите, пожалуйста, закрыть зияющую дыру некомпетентности.
Есть необходимость еженедельно править довольно большую сводную таблицу и для дальнейшей обработки информации вручную правлю значения в множестве ячеек. Принцип изменения указал на скриншоте.
и таких ячеек оооочень много.
Как можно автоматизировать процесс?

Заранее огромное человеческое спасибо!
Всех благ.
Изменено: Артур Иванов - 12.10.2021 09:21:46
 
Доброго. До вашей ручной замены в ячейке что? Текст? После вашей ручной замены - в ячейке появляется что? Число в нужном формате, текст? Покажите в файле примере - вот исходные, вот надо чтобы стало так.
З.Ы. Мы по фотографии не работаем, мы люди серьезные, не то что шарлатаны с Рен-ТВ.
Только файл Excel, только хардкор!
Изменено: Пытливый - 12.10.2021 09:22:59
Кому решение нужно - тот пример и рисует.
 
До моей замены да, просто текст. Меняю на вбитое вручную значение с изменением формата ячейки на  "время"
Пример приложил.

По скриншоту понял, извиняюсь, исправляюсь :-)
Изменено: Артур Иванов - 12.10.2021 09:29:39
 
Код
Function ФОРМАТВРЕМЯ(cl As Range) As Date
    Dim dt As Date
    Dim txt As String
    txt = cl.Value
    txt = Trim(txt)
    If txt <> "" Then
        Do
            If InStr(txt, "  ") = 0 Then Exit Do
            txt = Replace(txt, "  ", " ")
        Loop
        Dim arr As Variant
        arr = Split(txt, " ")
        
        Dim i As Integer
        For i = 1 To UBound(arr)
            Select Case Left(LCase(arr(i)), 3)
            Case "час": dt = dt + TimeSerial(arr(i - 1), 0, 0)
            Case "мин": dt = dt + TimeSerial(0, arr(i - 1), 0)
            Case "сек": dt = dt + TimeSerial(0, 0, arr(i - 1))
            End Select
        Next
    End If
    ФОРМАТВРЕМЯ = dt
End Function

 
А с помощью этого макроса, можно преобразовывать выделенный диапазон.
Код
Sub ПРЕОБРАЗОВАТЬВФОРМАТВРЕМЯ()
    Dim rn As Range
    On Error Resume Next
    Set rn = Intersect(Selection, ActiveSheet.UsedRange)
    On Error GoTo 0
    If Not rn Is Nothing Then
        Dim Application_Calculation As Long
        Application_Calculation = Application.Calculation
        Application.Calculation = xlCalculationManual
        Application.EnableEvents = False
        Dim cl As Range
        For Each cl In rn
            cl.NumberFormat = "[h]:mm:ss;@"
            cl.Value = ФОРМАТВРЕМЯ(cl)
        Next
        Application.EnableEvents = True
        Application.Calculation = Application_Calculation
    End If
End Sub
 
Или еще так (тоже пользовательская функция) - см.файл.
Кому решение нужно - тот пример и рисует.
 
Огромное спасибо!
Буду изучать!
Готов отблагодарить рублем.
Страницы: 1
Наверх