Как сделать al oop между фиксированной датой "чч: сс" и диапазоном ячеек - PullRequest
0 голосов
/ 16 марта 2020

Как сравнить ячейку даты "чч: сс" Z4 с диапазоном в том же формате (AB4: AB19). Он должен взять ячейку Z4 и посмотреть, равна ли она какой-либо другой ячейке в диапазоне, если это правда, он должен добавить две минуты и посмотреть снова, и продолжать делать это, пока значение не будет найдено в диапазоне.

Всякий раз, когда он находит значение, которое не находится в диапазоне, он должен поместить это значение в ячейку AB4. Это следует сделать со всеми значениями позже (Z5, Z6 ... Z19). Я добавляю и изображение в качестве примера, который показывает, что значение уже существует, и мне нужно всякий раз, когда я нажимаю sh кнопку «Grabar TOBT», чтобы запустить этот код по отдельности.

enter image description here Sub CompTSAT1 ()

    Dim VALTSAT1 As Date
    VALSAT1 = Z4

    Do While VALSAT1 = Range("AB4:AB19")
        VALSAT1 = DateAdd(n, 2, VALSAT1)

        Exit Do

        AB4 = VALSAT1
    Loop

End Sub

Ответы [ 3 ]

0 голосов
/ 17 марта 2020

Попробуйте код ниже:

Sub CheckTSAT()

Dim lastRowIndex As Long
Dim wsData As Worksheet
Dim tobtRange As Range
Dim tsatRange As Range
Dim tobt As Range
Dim tobtTime As Single
Dim i As Long

'//Supose that you sheet is named 'Data'
Set wsData = Sheets("Data")

'//Get ranges
Set tobtRange = wsData.Range("Z4:Z" & wsData.Cells(Rows.Count, "Z").End(xlUp).Row)
Set tsatRange = wsData.Range("AB4:AB" & wsData.Cells(Rows.Count, "AB").End(xlUp).Row)

'//Looping through all filled cells in the columns TBOT manual
For Each tobt In tobtRange

    '//Get week number from cell in column "AM"
    tobtTime = tobt.Value
    teste = Format(tobtTime, "hh:mm:ss")

    '//Count TOBT time in the TSAT range
    checkTobtTimeInTsat = Application.WorksheetFunction.CountIf( _
    tsatRange, Format(tobtTime, "hh:mm:ss"))

    '//Check if the TOBT time exist in TSAT range
    If checkTobtTimeInTsat > 0 Then

        '//Add 2 minutes to the TOBT time
        tobtTime = DateAdd("n", 2, tobtTime)
    Else
        '//Shifts the range AB4 down
        wsData.Range("AB4").Insert Shift:=xlDown

        '//Put the updated TOBT time in cell AB4
        wsData.Range("AB4").Value = Format(tobtTime, "hh:mm:ss")
    End If
Next

End Sub
0 голосов
/ 17 марта 2020

В конце, с некоторой помощью в stackoverflow в испанском sh, я нашел способ того, что искал:

Option Explicit

Sub GrabarTOBT()

Dim HorasOcupadas As Object: Set HorasOcupadas = CargaHorasOcupadas
Dim HoraStr As String
Dim HoraDeseada As Date
HoraDeseada = ActiveCell.Value
HoraStr = Format(HoraDeseada, "hh:mm")
Dim HoraOcupada As Boolean: HoraOcupada = HorasOcupadas.Exists(HoraStr)
Do While HoraOcupada
    HoraDeseada = DateAdd("n", 2, HoraDeseada)
    HoraStr = Format(HoraDeseada, "hh:mm")
    HoraOcupada = HorasOcupadas.Exists(HoraStr)
Loop
With ThisWorkbook.Sheets("Hoja1") 'Cambia Hoja1 por la hoja donde tienes los datos
    Dim lrow: lrow = .Cells(.Rows.Count, "AB").End(xlUp).Row + 1
    .Cells(lrow, "AB").Value = Format(HoraDeseada, "hh:mm")
End With

End Sub

Private Function CargaHorasOcupadas() As Object
Dim Dict As Object: Set Dict = CreateObject("Scripting.Dictionary")
With ThisWorkbook.Sheets("Hoja1") 'Cambia Hoja1 por la hoja donde tienes los datos
    Dim lrow As Long: lrow = .Cells(.Rows.Count, "AB").End(xlUp).Row
    If lrow > 3 Then
        Dim C As Range
        Dim Hora As String
        For Each C In .Range("AB4:AB" & lrow)
            Hora = Format(C, "hh:mm")
            Dict.Add Hora, 1
        Next C
    End If
End With
Set CargaHorasOcupadas = Dict

End Function
0 голосов
/ 16 марта 2020

Пожалуйста, попробуйте следующий код: когда значение из столбца Z будет найдено в AB, будет рассчитано время с плюсом 2 минуты, и вы можете установить исходное время вместо модифицированного. Для этого нужно нажать Ctrl + G. Результат можно увидеть в «Немедленном окне».

Sub testChangeTimeVal()
  Dim sh As Worksheet, i As Long, j As Long
   Set sh = ActiveSheet
    For i = 4 To sh.Range("Z" & Cells.Rows.Count).End(xlUp).Row
        For j = 4 To sh.Range("Z" & Cells.Rows.Count).End(xlUp).Row
            If sh.Range("Z" & i).value = sh.Range("AB" & j).value Then
                Debug.Print Format(sh.Range("AB" & i).value, "hh:mm:ss"), _
                        Split(Format(sh.Range("AB" & i).value, "hh:mm:ss"), ":")(0) & ":" & _
                        CLng(Split(Format(sh.Range("AB" & i).value, "hh:mm:ss"), ":")(1)) + 2 & ":" & _
                        Split(Format(sh.Range("AB" & i).value, "hh:mm:ss"), ":")(2)
            End If
        Next j
    Next i
End Sub
...