Блог

Я новичок в VBA, и у меня есть расписание (скриншот ниже), которое я пытаюсь изменить с помощью пользовательской формы.

У меня есть пользовательская форма с 3 выпадающими списками, 1 для типа выполняемой процедуры, а затем 1 для времени начала, а другой для времени окончания (эти времена основаны на первой строке на скриншоте).

Я хочу существенно изменить электронную таблицу для определенной процедуры, используя пользовательскую форму. Например, допустим, я хочу изменить процедуру 7 на длительность с 2:00 до 19:00. В подобном случае я бы хотел, чтобы все строки, в которых есть 7, были заполнены 7 в этих столбцах (см. Скриншот результата)

Все, что у меня есть, это код для определения, какие строки содержат определенное значение, а затем это значение смещается… но я, честно говоря, не знаю, куда идти дальше… Любая помощь приветствуется!!!

 Dim c As Range
Dim firstAddress As String

Count = 7

With Sheet49.Range("AA7:AA636")
    Set c = .Find(7, LookIn:=xlValues)
    If Not c Is Nothing Then
        firstAddress = c.Address
        Do While Not c Is Nothing
            Count = Count   1
            c.Offset(, -8).Value = c.Value
            Set c = .FindNext(c)
            If Count = 636 Then
            Exit Do
            End If
        Loop
    End If
End With
 

я хочу изменить процедуру 7 на длительность с 2:00 до 19:00. В подобном случае я бы хотел, чтобы все строки, в которых есть 7, были заполнены 7 в этих столбцах

Логические:

1. Найдите столбцы времени начала и окончания
2. Найдите соответствующую процедуру, а затем заполните весь диапазон за 1 раз!

Код:

 Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim ColA As Long, ColB As Long
    Dim aCell As Range, bCell As Range
    Dim i As Long
    
    '~~> I am hardcoding these values. Pick them up from combobox
    Dim ProcToFind As Long: ProcToFind = 7
    Dim StartTime As String: StartTime = "2:00"
    Dim EndTime As String: EndTime = "19:00"
    
    '~~> Change this to the relevant sheet
    Set ws = Sheet1
    
    With ws
        '~~> Find the start and end time columns
        '~~> Hardcoded 21. Replace with last column
        For i = 1 To 21
            Select Case TimeValue(Format(.Cells(1, i).Value, "hh:mm:ss"))
                Case TimeValue(StartTime): ColA = i
                Case TimeValue(EndTime): ColB = i
            End Select
        Next i
        
        If ColA = 0 Or ColB = 0 Then
            MsgBox "Unable to find start or end time column(s)"
            Exit Sub
        End If
        
        Set aCell = .Cells.Find(What:=ProcToFind, LookIn:=xlValues, _
                    LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
                    MatchCase:=False, SearchFormat:=False)

        If Not aCell Is Nothing Then
            Set bCell = aCell
            
            '~~> Fill the entire range in 1 go
            .Range(.Cells(aCell.Row, ColA), .Cells(aCell.Row, ColB)).Value = ProcToFind
            
            Do
                Set aCell = .Cells.FindNext(After:=aCell)

                If Not aCell Is Nothing Then
                    If aCell.Address = bCell.Address Then Exit Do
                    
                    '~~> Fill the entire range in 1 go
                    .Range(.Cells(aCell.Row, ColA), .Cells(aCell.Row, ColB)).Value = ProcToFind
                Else
                    Exit Do
                End If
            Loop
        End If
    End With
End Sub
 

В действии: