Перемещение до определенного диапазона ячеек

Question

Я пытаюсь запустить программу, которая позволяет мне видеть, какие комнаты в колледже бесплатны в определенное время в Microsoft Excel.

Проблемы я имею после того как я определить пустой слот класса:

• как doIi кода, чтобы идти обратно в имена всех номеров класса люкса (Все имена в строке 2)
• и сохраните значение этого.

Я пробовал компенсировать, но это не сработало бы для меня.

Я добавил Sample Data для дальнейшего уточнения

Public Sub EXq3() 

Dim rnR1 As Range, roomNum As Integer 

Const rooms = 13 ' Counter amount 
Set rgR1 = ActiveCell.Offset(0, 1) 
timeSolt = InputBox("What time") ' asks user what time to enter 

Cells.find(What:=timeSolt, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ 
      xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ 
     , SearchFormat:=False).Activate ' search and find code 

For counter = 1 To rooms 
    If rgR1.Value = "" Then roomNum = rgR1.Offset(Range(2, rgR1.Value)) ' attempt at getting it to go to range 2 
    rgR1.Activate 
    Set rgR1 = rgR1.Offset(0, 1) 
Next counter 
MsgBox roomNum 

End Sub 

Answer 1

Вам вероятно «перейти в диапазон 2» означает «перейти к строке 2», я прав? Если да, то это ваше решение:

For counter = 1 To rooms 
    If rgR1.Value = "" Then 
     roomNum = Cells(2, rgR1.Column).Value 
    End If 
    rgR1.Activate 
    Set rgR1 = rgR1.Offset(0, 1) 
Next counter 

EDIT

Итак, я предполагаю, что у вас есть несколько вариантов времени в колонке А, и некоторые значения номер 1 в столбце B, номер 2 в столбец C и т. д. Я отредактировал ваш код, чтобы избавиться от перемещения активной ячейки. Он находит некоторое время в столбце A и проверяет, есть ли пустые ячейки в строке с этим параметром времени, и возвращает сообщения с номерами этих комнат.

Мой тестовый лист:

Код:

Public Sub EXq3() 

Dim rnR1 As Range, roomNum As String, rooms As Integer Dim timeSolt As String 

rooms = 13 ' Counter amount timeSolt = InputBox("What time") ' asks user what time to enter 

Set rnR1 = ActiveSheet.Columns("A:A").Find(What:=timeSolt, LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False) ' search and find code 

If rnR1 Is Nothing Then 
    MsgBox "Something is wrong with Input." 
Else 
    For col = 2 To rooms + 1 
     If Cells(rnR1.Row, col).Value = "" Then 
      roomNum = Cells(2, col).Value 
      MsgBox roomNum 
     End If 
    Next col 
End If 

End Sub 

Итак, я. е. когда вы вводите 17 во всплывающем окне, результатом будет «Комната 4» и «Комната 10».

Answer 2

Не нужно Set rgR1 = ActiveCell.Offset(0, 1), вы можете просто найти TimeSlot, введенный в InputBox на всей вашей рабочей таблице.

Кроме того, лучше держаться подальше от Activate и ActiveCell и вместо этого использовать ссылочные Range s.

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

В комментариях к коду есть больше пояснений.

Код

Option Explicit 

Public Sub EXq3() 

Dim rnR1 As Range, roomNum As Variant, TimeSlot 
Dim FindRng As Range, i As Integer, Counter As Integer 

Const rooms = 13 ' Counter amount 
ReDim roomNum(1 To 1000) ' init Rooms avaialable array to a large size 
i = 1 '<-- reset Rooms Array index 

TimeSlot = InputBox("What time") ' asks user what time to enter 

Set FindRng = Cells.Find(What:=TimeSlot, After:=Range("A1"), LookIn:=xlFormulas, LookAt:= _ 
        xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ 
        , SearchFormat:=False) ' search and find TimeSlot 

If Not FindRng Is Nothing Then '<-- was able to find the timeslot in the worksheet 
    For Counter = 1 To rooms 
     If Cells(FindRng.Row, Counter + 1).Value = "" Then '<-- add 1 to counter since starting from Column B 
      roomNum(i) = Cells(2, Counter + 1).Value '<-- save room number inside the array 
      i = i + 1 
     End If 
    Next Counter 

    ReDim Preserve roomNum(1 To i - 1) ' <-- resize array back to number of available rooms found 

    ' loop through all available rooms in the array, and show a msgbox for each one 
    For i = 1 To UBound(roomNum) 
     MsgBox "Room number " & roomNum(i) & " is available at " & TimeSlot 
    Next i 
Else '<-- could bot find the timeslot in the worksheet 
    MsgBox "Couldn't find " & TimeSlot & " inside the worksheet!" 
End If 

End Sub 

Answer 3

вы могли бы попробовать это:

Public Sub EXq3() 
    Dim rnR1 As Range 
    Dim rooms As Integer 
    Dim timeSolt As String, roomNum As String 

    rooms = 13 ' Counter amount 
    With ActiveSheet 
     Do 
      timeSolt = Application.InputBox("What time", "Input time", Type:=2) 
      If timeSolt = CStr(False) Then Exit Sub '<--| exit if user cancels the dialogbox 
      Set rnR1 = .Columns("A:A").SpecialCells(XlCellType.xlCellTypeConstants, xlTextValues).Find(What:=timeSolt, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False) ' search and find code 
      If Not rnR1 Is Nothing Then Exit Do 
      MsgBox timeSolt & " is not a vaild time" & vbCrLf & vbCrLf & "please try again" 
     Loop 

     With .Range(rnR1.Offset(, 1), .Cells(rnR1.Row, .Columns.count).End(xlToLeft)) 
      If WorksheetFunction.CountBlank(.Cells) = 0 Then 
       MsgBox "Sorry! No rooms left for the input time" 
      Else 
       roomNum = .Parent.Cells(2, .SpecialCells(xlCellTypeBlanks).Cells(1, 1).Column) 
       MsgBox "First room available at " & timeSolt & " is room " & roomNum 
      End If 
     End With 
    End With 
End Sub