VBA - Зациклить строки и вставить значение на основе условия - PullRequest
Новая
       16

VBA - Зациклить строки и вставить значение на основе условия

0 голосов
/ 17 сентября 2018

Мой вопрос о цикле excel VBA.Я хочу, чтобы цикл начинал заполнять результаты с начала, когда изменяются определенные значения ячеек.

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

Условие № 1 = Должен начать расчет временного окна, когда время даты заказа превышает 21:00 часов, однако я хочу зациклить, пока не придет новая дата и начать заполнениевремя окна снова начинается с начала, когда следующая дата имеет 21: 00

Учитывая, что 1 цессионарий может работать с 10 заказами за 1 час, тогда как 2 цессионария могут работать с 20 заказами за 1 час и т. д ....

Sub EstimatedTimeWindow()
Dim i as long, n as long,
Dim x as double
Dim p as long

    No_of_Orders = 20
    No_of_Assignee  = 2
    OrdersinHour = No_of_Orders  * No_of_Assignee

   Worksheets("final_data").select
   n = cells(rows.count,"A").end(xlup).row
   p = 0

   For i = 2 to n
   x = (1* cells(i,"A")/1)) - Int(Cells(i,"A")) 'to check the time
  If x >= 0.875 'time as 21:00
     p = p + 1
       If p <= OrdersinHour Then
          Cells(i,"B") = "Estimated window time 21:00 - 22:00"
       End If
       If p > OrdersinHour AND p <= OrdersinHour * 2 Then
          Cells(i,"B") = "Estimated window time 22:00 - 23:00"
       End if
       If p > OrdersinHour AND p <= OrdersinHour * 3 Then
          Cells(i,"B") = "Estimated window time 23:00 - 00:00"
       End if
       If p > OrdersinHour AND p <= OrdersinHour * 4 Then
          Cells(i,"B") = "Estimated window time 00:00 - 01:00"
       End if
  End if
Next
End Sub

sample_image

1 Ответ

0 голосов
/ 20 сентября 2018

Неправильный вопрос: я оставил этот ответ ниже, но его можно игнорировать. Обновленный ответ добавлен в начало:

Не сбрасывайте Date с x - тогда, когда день в ячейке не совпадает с предыдущим днем ​​строки, сбросьте p на 0 

For i = 2 to n
    If Int(I) <> Int(cells(I,1).Value Then 'Order Date has changed day
        p = 0 'Reset counter p to 0
    End If
    x = cells(i,1).Value 'to check the time
    If (x mod 1) >= 0.875 'time as 21:00
'Continue as normal

Вы можете вызвать макрос в определенное время с помощью Application.OnTime - однако, если вы закроете книгу, но оставите ее открытой в Excel, откроет книгу для запуска макроса, если вы не отключите OnTime. Это становится ... грязным.

Лучшим решением было бы использование события Worksheet_Change для запуска кода при изменении значений на рабочем листе: 

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Me.Columns(1)) Is Nothing Then 'A Cell in Column A changed
        Call EstimatedTimeWindow
    End If
End Sub

Кроме того, быстрая настройка существующего кода: x = Cells(i, 1).Value Mod 1 даст вам время с более чистым кодом, оператор Hour легче читать, чем 0,875, а оператор Switch для p сделает ваш код чище тоже: 

For i = 2 to n
    If Int(x) <> Int(Cells(i,1).Value) Then
        p = 0
    End If
    x = Cells(i, 1).Value 'Since we take the Hour, no need to trim the date off first
    If Hour(x) >= 9 Then
        p = p + 1
        Select Case (p\OrdersinHour) 'Same as Int(p/OrdersinHour)
            Case 0:
                Cells(i,2).value = "Estimated window time 21:00 - 22:00"
            Case 1:
                Cells(i,2).value = "Estimated window time 22:00 - 23:00"
            Case 2:
                Cells(i,2).value = "Estimated window time 23:00 - 20:00"
            Case 3:
                Cells(i,2).value = "Estimated window time 00:00 - 01:00"
        End Select
    End IF
Next
...