Сложный макрос Excel VBA с контуром

Question

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

Я пробовал записывать макросы, но я в лучшем случае, чтобы подойти к нему. Любая помощь будет принята с благодарностью. В простейших терминах мне нужно найти термин (т. Е. «ЭТО ИСПЫТАНИЕ»), скопируйте эту ячейку в новый рабочий лист, перейдите на 72 ячейки и скопируйте все, что находится в этой ячейке, в новый рабочий лист.

Логика для макро Loop VBA ...

1. Сканирование через все рабочие листы для слов «это тест»
2. Скопируйте эту ячейку в новую таблицу (например, А1)
3. Go 72 клеток до
4. Скопируйте эту ячейку в новую таблицу (например, B1)

Он должен через цикл выше логики во всех открытых рабочих листов, сбрасывая результаты в новый рабочий лист.

Еще раз спасибо за любую помощь, которую я получаю.

Answer 1

Это старт. Ваши заметки предполагают, что слова будут встречаться только один раз на каждом листе и что будет ячейка 72 строк назад. Я включил примечания по проверке этих двух предметов, но только наглядно.

Dim c As Range 
Dim s As Worksheet 
Dim sr As Worksheet ''For results 
Dim r1 As Long ''Row counter 
Dim i As Long ''Incidence counter 
Dim firstAddress As Variant 

''New worksheet for results 
Set sr = ActiveWorkbook.Worksheets.Add 
r1 = 1 

''It might be better to use a named workbook 
For Each s In ActiveWorkbook.Worksheets 
    ''Don't check results sheet 
    If s.Name <> sr.Name Then 
    ''From: http://msdn.microsoft.com/en-us/library/aa195730(v=office.11).aspx 
     With s.UsedRange 
      Set c = .Find("THIS IS A TEST", LookIn:=xlValues, LookAt:=xlWhole) 
      i = 0 
      If Not c Is Nothing Then 
       firstAddress = c.Address 
       sr.Cells(r1, 1) = c.Value 

       If c.Row - 72 > 0 Then 
        sr.Cells(r1, 2) = s.Cells(c.Row - 72, c.Column) 
       Else 
        sr.Cells(r1, 2) = "Error" 
       End If 

       i = 1 
       r1 = r1 + 1 

       Do 
        i = i + 1 
        Set c = .FindNext(c) 
       Loop While Not c Is Nothing And c.Address <> firstAddress 
      End If 
     End With 
    End If 
    Debug.Print s.Name & " found: " & i 
Next