Excel, извлечь время Перерыв из одной ячейки в листе Excel?

Question

У меня есть лист Excel, как показано ниже, и мне нужно только три "Разрыва" раза, даже если это означало удалить все, кроме этих трех Перерывов в каждой ячейке.

Function GetBreaksTime(txt As String)
    Dim i As Long
    Dim arr As Variant

    arr = Split(txt, "Break")
    If UBound(arr) > 0 Then
        ReDim startTimes(1 To UBound(arr)) As String
        For i = 1 To UBound(arr)
            startTimes(i) = WorksheetFunction.Trim(Replace(Split(arr(i), "-")(0), vbLf, ""))
        Next
        GetBreaksTime = startTimes
    End If  
End Function

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

Так есть идеи, как это сделать?

Answer 1

Если вы разделите значение ячейки на vbLf, то время перерыва всегда будет следовать за строкой, содержащей "Break".

Должно работать следующее:

Sub TestGetBreakTimes()
    Dim CellValue As String
    CellValue = Worksheets("Sheet1").Range("A1").Value

    Dim BreakTimes As Variant
    BreakTimes = GetBreakTimes(CellValue)

    Debug.Print Join(BreakTimes, vbLf)  'the join is just to output the array at once.

    'to output in different cells loop through the array
    Dim i As Long
    For i = 0 To UBound(BreakTimes)
        Cells(3 + i, "A") = BreakTimes(i)
    Next i

    'or for a even faster output use
    Range("A3").Resize(UBound(BreakTimes) + 1).Value = WorksheetFunction.Transpose(BreakTimes)
End Sub

Function GetBreakTimes(InputData As String) As Variant
    Dim BreakTimes() As Variant
    ReDim BreakTimes(0)

    Dim SplitArr As Variant
    SplitArr = Split(InputData, vbLf) 'split by line break

    If UBound(SplitArr) > 0 Then
        Dim i As Long
        For i = 0 To UBound(SplitArr)
            If SplitArr(i) = "Break" Then 'if line contains break then next line is the time of the break
                If BreakTimes(0) <> vbNullString Then ReDim Preserve BreakTimes(UBound(BreakTimes) + 1)
                BreakTimes(UBound(BreakTimes)) = SplitArr(i - 1) 'collect break time
            End If
        Next i
        GetBreakTimes = BreakTimes
    End If
End Function

Чтобы проанализировать полный диапазон, вы должны перебрать строку 2

Sub GetAllBreakTimes()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")

    Dim LastCol As Long
    LastCol = ws.Cells(2, ws.Columns.Count).End(xlToLeft).Column

    Dim BreakTimes As Variant

    Dim iCol As Long
    For iCol = 1 To LastCol
        BreakTimes = GetBreakTimes(ws.Cells(2, iCol).Value)
        ws.Cells(3, iCol).Resize(UBound(BreakTimes) + 1).Value = WorksheetFunction.Transpose(BreakTimes)
    Next iCol
End Sub