Обход элементов массива и извлечение разделенных значений при выполнении условия

Question

Я хочу l oop через массив и извлечь его значения с разделителями, которые соответствуют каждой дате в диапазоне. Например, на рисунке ниже:

1. У меня есть диапазон дат, скажем, с 01-01 по 01-10.
2. У меня также есть список строк (см. Второй пи c).
3. В приведенном ниже массиве (см. Первый pi c) у меня есть три различных значения, разделенных точкой с запятой.
4. Для всех соответствующих строк (от второго числа *) 1046 *) Например, SISBTXTRPR- (число) и дата, я хочу извлечь последнюю часть значения массива.

Изображение 1

Изображение 2

Итак, для всех значений массива, которые соответствуют «SISBTXTRPR-4649» (строка из рисунка 2) и дате (в данном случае 12-12), я хочу извлечь «2h» из массива. Диапазон дат для каждой строки, в данном случае «SISBTXTRPR-4649», составит 10 дней. Я пытаюсь понять, как это сделать: (

Это все, что я мог придумать:

While i < UBound(sTimeStamp)
If StrComp(Trim(Format(Now(), "MM-DD")), Trim(Split(sTimeStamp(9), ";")(1))) = 0 And StrComp(Trim(Worksheets("KPIs").Range("AN" & iCounter)), Trim(Split(sTimeStamp(1), ";")(0))) Then

End If
i = i + 1
Wend

Ссылка на файл

Образец файла

Answer 1

Следующий код будет возвращать вхождения для каждой строки в диапазоне «Задача», совпадающей с датой из соответствующей строки «Массив sTimeStamp» и из строки «Массив диапазона дат». Каждое вхождение будет добавлено к следующему столбцу строкового столбца «Задача»:

Private Sub findOccurrences()
  Dim sTask As Worksheet, sStamp As Worksheet, sDate As Worksheet
  Dim arrTask As Variant, arrStamp As Variant, arrDate As Variant
  Dim i As Long, j As Long, arrS As Variant, El As Variant, dtRef As Date

  Set sTask = ThisWorkbook.Sheets("Task")
  Set sStamp = ThisWorkbook.Sheets("sTimeStamp Array")
  Set sDate = ThisWorkbook.Sheets("Date Range Array")
    arrTask = sTask.Range("A2:A" & sTask.Range("A" & sTask.Rows.Count).End(xlUp).Row).Value
    arrStamp = sStamp.Range("A2:A" & sStamp.Range("A" & sStamp.Rows.Count).End(xlUp).Row).Value
    arrDate = sDate.Range("A2:A" & sDate.Range("A" & sDate.Rows.Count).End(xlUp).Row).Value

    '____________________________________________________________________________  
    sTask.Range("B2:K" & sTask.Range("A" & sTask.Rows.Count).End(xlUp).Row).Clear  
    Do While i < UBound(arrStamp)
        i = i + 1
        arrS = Split(arrStamp(i, 1), ";")
        For j = 1 To UBound(arrTask)
            If arrS(0) = arrTask(j, 1) Then
                For Each El In arrDate
                    dtRef = DateValue(Format(El, "MM-DD"))
                    If dtRef = DateValue(Format(arrS(1), "MM-DD")) Then
                        Debug.Print arrS(0) & " (row number " & j + 1 & "), interval """ & _
                                                                        El & """ exists."
                        sTask.Cells(j + 1, sTask.Cells(j + 1, _
                            sTask.Columns.Count).End(xlToLeft).Column).Offset(0, 1).Value = El
                    End If
                Next
            End If
        Next j
    Loop

End Sub

И короткий вариант, работающий аналогично вашему подходу, найдет вхождения на дату Сегодня (если я правильно вывел то, что вы намеревались выполнить), замените часть цикла следующим образом:

'______________________________________________________________________________
    sStamp.Range("B2:B" & sStamp.Range("A" & sStamp.Rows.Count).End(xlUp).Row).Clear
sTask.Range("A2:A" & sTask.Range("A" & sStamp.Rows.Count).End(xlUp).Row).Interior.ColorIndex = -4142
While i < UBound(arrStamp)
    i = i + 1
    If StrComp(DateValue(Format(Date, "MM-DD")), DateValue(Split(arrStamp(i, 1), ";")(1))) = 0 And _
                                Not isMatchErr(CStr(Split(arrStamp(i, 1), ";")(1)), arrDate) Then
        Debug.Print "OK for """ & Split(arrStamp(i, 1), ";")(0) & """ of row """ & i & """."
        sStamp.Range("B" & i + 1).Value = "OK"
        If Not isMatchErr(CStr(Split(arrStamp(i, 1), ";")(0)), arrTask) Then
            rowOK = WorksheetFunction.Match(Split(arrStamp(i, 1), ";")(0), arrTask, 0) + 1
            sTask.Range("A" & rowOK).Interior.ColorIndex = 3
        End If
    End If
Wend

и добавьте следующую функцию:

Function isMatchErr(strTime As String, arrDate As Variant) As Boolean
   Dim k As Long
   On Error Resume Next
     k = WorksheetFunction.Match(strTime, arrDate, 0)
     If Err.Number <> 0 Then
        Err.Clear: On Error GoTo 0: isMatchErr = True
     End If
   On Error GoTo 0
End Function

Помимо сообщения в «Немедленном окне», в столбец будет добавлено «ОК». B: B для всех вхождений (в листе 'sTimeStamp Array') и фон соответствующей ячейки (в листе 'Task' будет окрашен в красный цвет ... Для этого я добавил новую запись и изменил существующую ячейку , для «Сегодня» («01-12»). Пожалуйста, сделайте то же самое, чтобы получить как минимум два результата в столбце B: B.

Пожалуйста, подтвердите, что это то, что вы хотели. Если нет, пожалуйста, лучше уточнить необходимость ...