Цикл макрос по строкам

Question

РЕДАКТИРОВАТЬ: я очистил код, как показано ниже. Я пытаюсь найти способ выполнить код с простым добавлением 1 к строке в диапазонах смещения. Это возможно?? введите описание изображения здесь

Что я пытаюсь сделать:

1. Найти столбцы «Wage QRE Exp» а. Если вышеуказанная ячейка оставлена ​​рядом с «Ref.», Тогда я хочу найти их значения ниже
2. Применить макрос ко всем строкам между серыми строками столбца «QRE». а. Заполните номера ссылок на страницы в соседних левых ячейках б. Делать, пока цвет ячейки = Серый -25% (.ThemeColor = xlThemeColorDark2) Я считаю

3. Конец

   Sub Find_Data()
   Dim datatoFind As String, MySheet As String, FV As String
   Dim aSh As Worksheet, fSh As Worksheet
   Dim firstResult As Range
   Dim secondResult As Range
   Dim rng As Range
   Dim LeftCell As Range
   Dim leftValue As String
   
   Set rng = Cells.Find(What:="Wage QRE Exp", after:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
   Set LeftCell = rng.Offset(0, -1)
   leftValue = LeftCell.Value
   If leftValue = "Ref." Then
      Set findValue = rng.Offset(1, 0)
      Set aSh = Sheet1
      datatoFind = findValue
   
      sheetCount = ActiveWorkbook.Sheets.Count
      If Len(datatoFind) = 0 Or Not IsNumeric(datatoFind) Then Exit Sub
      For counter = 1 To sheetCount
         Sheets(counter).Activate
         Set firstResult = Cells.Find(What:=datatoFind, after:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, SearchFormat:=False)
         Set secondResult = Cells.FindNext(after:=firstResult)
         Debug.Print secondResult.Address
         If Not firstResult Is Nothing Then
             MySheet = IIf(InStr(secondResult.Parent.Name, "."), Split(secondResult.Parent.Name, ".")(0), Split(secondResult.Parent.Name)(0))
             FV = MySheet & "." & pageNum(secondResult)
         Else
         End If
      Next counter
      With rng.Offset(1, -1)
          .Value = FV
          .Font.Name = "Times New Roman"
          .Font.Bold = True
          .Font.Size = "10"
          .Font.Color = vbRed
          .HorizontalAlignment = xlRight
          .VerticalAlignment = xlCenter
      End With
   End If
   

   End Sub

Answer 1

Ваш код немного сложен для исполнения, потому что вы не слишком много делаете отступы (я это редактировал) и нет комментариев. Поэтому я не уверен, какой раздел вы хотите повторить.

Обычно я предлагаю цикл Do. И идентифицируйте последнюю строку по ее содержанию, а не по цвету.

Установите ColAcell в ячейку A5, затем:

Do Until ColAcell.value = "Total"

   ... (your code to process the row) ...

   Set ColAcell = ColAcell.offset(1,0)

Loop