Цикл в цикле — Vba

#vba #loops #nested-loops

Вопрос:

Я изо всех сил пытаюсь выполнить это упражнение, поэтому прошу вас о помощи.

У меня есть таблица со следующими данными:

изображение с данными

Мне нужно 2 петли:

  • 1, один циклический столбец «BX» из последней строки во 2 и поиск 2 значений (первый день недели и последний день недели) в столбце BV. Затем вычитаем соответствующие значения из столбца «BW».
    • Пример: Число 37-это значение последней строки («BX»), которое следует просмотреть в столбце «BV» (дважды), получить соответствующие значения: 15,5 и 14,25. Вычтите их и получите результат.
  • 2, второй будет входить в любой свободный столбец (т. Е. «BZ») и вставлять результаты предыдущих вычитаний один за другим.

Первая часть выполнена со следующим кодом:

 lastc = ws.Cells(1, ws.Columns.count).End(xlToLeft).Column
lastr = ws.Cells(ws.Rows.count, lastc).End(xlUp).Row
lastr2 = ws.Cells(ws.Rows.count, lastc - 2).End(xlUp).Row

For R = lastr To 2 Step -1
lastr = R

Set FindRow = ws.Range(ws.Cells(1, lastc - 2), ws.Cells(lastr2, lastc - 2)).Find(What:=ws.Cells(R, lastc))
FindRowNumber = FindRow.Row
Set CellPosition = Cells(FindRowNumber, lastc - 1)
Set FindRow2 = ws.Range(ws.Cells(1, lastc - 2), ws.Cells(lastr2, lastc - 2)).Find(What:=ws.Cells(R, lastc), SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
Find RowNumber2 = FindRow2.Row
Set CellPosition2 = Cells(FindRowNumber2, lastc - 1)

Next R
 

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

Спасибо вам за ваши советы.

Ответ №1:

Я добавил операции в ваш код для накопления и вывода результатов:

 Sub test1()
    Set ws = ActiveSheet
    
    ws.Columns("BZ").ClearContents  ' clear output column
    
    lastc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    lastr = ws.Cells(ws.Rows.Count, lastc).End(xlUp).Row
    lastr2 = ws.Cells(ws.Rows.Count, lastc - 2).End(xlUp).Row
    
    Dim col As New Collection   'declare and create collection for results accumulation
    
    For R = lastr To 2 Step -1
        lastr = R
        
        Set FindRow = ws.Range(ws.Cells(1, lastc - 2), ws.Cells(lastr2, lastc - 2)).Find(What:=ws.Cells(R, lastc))
        FindRowNumber = FindRow.Row
        Set CellPosition = ws.Cells(FindRowNumber, lastc - 1)
        Set FindRow2 = ws.Range(ws.Cells(1, lastc - 2), ws.Cells(lastr2, lastc - 2)).Find(What:=ws.Cells(R, lastc), SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
        FindRowNumber2 = FindRow2.Row
        Set CellPosition2 = ws.Cells(FindRowNumber2, lastc - 1)

        col.Add CellPosition2 - CellPosition    ' accumulate results in the collection
    Next R
    
    ' output previously accumulated results one-by-one
    cnt = 2 'skip header row
    For Each col_element In col
        ws.Cells(cnt, "BZ") = col_element
        cnt = cnt   1
    Next
End Sub
 

введите описание изображения здесь

На мой взгляд, дополнительный цикл вывода не нужен,
правильнее было бы выводить результаты в той же строке, что и обработанное
значение в столбце «BX», для визуального сравнения обработанного
значения и результата

Вариант 2

 Sub test2()
    Set ws = ActiveSheet
    
    ws.Columns("BZ").ClearContents  ' clear output column
    
    lastc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
    lastr = ws.Cells(ws.Rows.Count, lastc).End(xlUp).Row
    lastr2 = ws.Cells(ws.Rows.Count, lastc - 2).End(xlUp).Row
    
    For R = lastr To 2 Step -1
        lastr = R
        
        Set FindRow = ws.Range(ws.Cells(1, lastc - 2), ws.Cells(lastr2, lastc - 2)).Find(What:=ws.Cells(R, lastc))
        FindRowNumber = FindRow.Row
        Set CellPosition = ws.Cells(FindRowNumber, lastc - 1)
        Set FindRow2 = ws.Range(ws.Cells(1, lastc - 2), ws.Cells(lastr2, lastc - 2)).Find(What:=ws.Cells(R, lastc), SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
        FindRowNumber2 = FindRow2.Row
        Set CellPosition2 = ws.Cells(FindRowNumber2, lastc - 1)
    
        ws.Cells(R, "BZ") = CellPosition2 - CellPosition ' output results
    Next R
End Sub
 

введите описание изображения здесь

Комментарии:

1. Здравствуйте, большое вам спасибо за правильный ответ. Очень признателен. Не могли бы вы, пожалуйста, уточнить размеры для возможности новой коллекции? Я работаю с опцией explicit, а col_element и ctn также должны быть затемнены.

2. col_element может быть объявлен как вариант, cnt как целое число или как длинный

3. хм, я правильно предположил. Однако я получаю значение результата как TRUE/FALSE вместо вычисления.

4. Пожалуйста, обновите свой код (в вопросе), который выдал TRUE/FALSE