Вложенные циклы VBA выходят рано - PullRequest
3 голосов
/ 08 марта 2012

У меня есть скрипт vba, который должен копировать данные с одного листа на другой.Это делается с помощью трех вложенных для циклов.Похоже, что пошаговое выполнение кода при отладке работает отлично, но при запуске сценария vba они перестают работать слишком рано.В противном случае скрипт vba работает.

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

Лист организован следующим образом:

Sheet1, содержит данные для копирования.

  • Каждая строка содержит отдельный ответ, которых в тестовых данных 55.
  • Лист содержит девять блоков данных, названныхЭпизод 1-9.Каждый эпизод содержит столбец, в котором целое число представляет время начала, окончания и интервала.
  • В данных теста каждый эпизод идентичен, за исключением времени начала / окончания.
  • Максимальное значение для EndTime:36
  • Тестовые данные относятся только к первым четырем блокам Episode, поэтому Episode4 содержит EndTime = 36 для каждой строки

Sheet2, куда должны идти данные. Первый столбец содержит каждыйRespondentID, скопированный в 36 строк -Второй столбец содержит номера 1-36, таким образом представляя этот временной интервал для этого респондента -11 Столбцы после этого содержат область, в которую помещаются данные, скопированные с листа 1 для этого Респондента / Время.Эти области размером 36x11 в тестовых данных называются «Response1-55»

Логика сценария vba следующая:

Счетчики: - n счетчик числа респондентов - r счетчик числаэпизодов - счетчик строк в копируемых ответах.

-> Для каждого ответа (начиная с n = 1 для респондентов)
-> Выберите первый эпизод (начиная с r = 19)
---> Для каждого эпизода
---> Считать время начала, окончания и интервала
---> Начиная с i = Начать с i = Конец скопировать соответствующие ячейки изn-й ряд r-го эпизода
---> скопировать эти ячейки в i-й ряд текущего ответа на sheet2
---> Когда вы достигнете EndTime текущего эпизода, перейдитек следующему (next r)
-> Если у только что законченного эпизода в качестве EndTime было 36, то переходите к следующему ответу или продолжайте, пока у вас не закончатся эпизоды.
-> Next Response

При отладке код, кажется, делает именно это.

Однако, когда я запускаю скрипт vba на тестовом листе, он работает только для эпизодов 1 и 2. Данные из эпизодов 3 и 4 не копируются.Ничто не копируется на свое место, и данные, которые копируются, верны во всех отношениях.Там нет сообщений об ошибках в любой момент.

Если бы кто-нибудь мог предположить, почему это может происходить, я бы построил им настоящую церковь.Ответ также можно добавить сюда: https://stackoverflow.com/questions/119323/nested-for-loops-in-different-languages В котором еще нет раздела для VBA.

Ссылка на контрольный лист находится здесь: http://dl.dropbox.com/u/41041934/MrExcelExample/TornHairExampleSheet.xlsm

Соответствующийчасть кода здесь

Sub PopulateMedia()
    Application.ScreenUpdating = False

    'Count the total number of response rows in original sheet
    Dim Responses As Long, n As Integer, i As Integer, r As Integer
        Responses = (Sheets("Sheet1").UsedRange.Rows.Count - 3) ' equals 55 in test sheet

    'For each response...
    For n = 1 To Responses
        i = 1 'Reset i for new response
            Dim curr_resp As Range
                Set curr_resp = Sheets(2).Range("Response" & n) 'Define a range containing all response data

            For r = 1 To 9  'For each episode...
                Dim curr_ep As Range 'Define a range containing episode data for all responses
                    Set curr_ep = Sheets(1).Range("episode" & r)

                Dim Stime As Integer, Etime As Integer, Itime As Integer 'Variables contain start, end and inter-episode times
                    Stime = curr_ep.Cells(n, 1)
                    Etime = curr_ep.Cells(n, 17)
                    Itime = curr_ep.Cells(n, 19)

                    For i = Stime To (Etime + Itime) 'for each time-slot...
                        If i <= Etime Then
                          Dim a As Variant
                            a = curr_ep.Range(curr_ep.Cells(n - 3, 1), curr_ep.Cells(n - 3, 11))
                            curr_resp.Rows(i) = a 'Copy data from above current episode to current response for slots between Stime and Etime
                        End If
                    Next i
                If Etime = 36 Then Exit For
             Next r
     Next n

    Application.ScreenUpdating = True
End Sub

Чтобы раскрыть, я уже помогал по этому проекту с этого сайта, VBA скопировать из объединения двух диапазонов в строку другого диапазона но с тех пор код немного изменился, и это другая проблема.

Еще раз, огромное спасибо за любую помощь, которая может прийти из этого.Я часами смотрю на это и не вижу, где ошибка.Любое руководство вообще высоко ценится.

1 Ответ

5 голосов
/ 08 марта 2012

Я бы опубликовал это как комментарий, если бы мог, но это слишком долго. Так что вот как запрос / потенциальное решение

Я думаю, что ваши диапазоны являются проблемой

Код ниже является урезанной версией вашего кода

curr_ep - это именованный диапазон эпизод1 . Он имеет диапазон адресов $Y$4:$AQ$58

Когда вы перебираете вариант a, вы устанавливаете диапазон с помощью этого синтаксиса
a = curr_ep.Range(curr_ep.Cells(n - 3, 1), curr_ep.Cells(n - 3, 11))
что эквивалентно a = curr_ep.Range("Y2:AQ2")

, что означает, что вы на самом деле смотрите на AW2:BG2, а не Y2:AQ2, что, как я думаю, вы могли иметь в виду, т.е.

Sub PopulateMedia()
    n = 1
    r = 1
    Dim curr_ep As Range
    Dim curr_test As Range
    Set curr_ep = Sheets(1).Range("episode" & r)
    Set curr_test = curr_ep.Range(curr_ep.Cells(n - 3, 1), curr_ep.Cells(n - 3, 11))
End Sub

enter image description here

...