Сложный макрос Excel VBA с циклом - PullRequest
Новая
       26

Сложный макрос Excel VBA с циклом

1 голос
/ 02 сентября 2010

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

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

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

  1. Сканирование всех листов на наличие слов "ЭТО ТЕСТ"
  2. Скопируйте эту ячейку в новый лист (например, A1)
  3. На 72 клетки вверх
  4. Скопируйте эту ячейку в новый рабочий лист (например, B1)

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

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

1 Ответ

3 голосов
/ 02 сентября 2010

Вот начало.Ваши заметки предполагают, что слова будут встречаться только один раз на каждом листе, и что будет ячейка 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
...