循环循环 - Vba

Question

我正在努力完成这个练习，因此我请求你的帮助。

我有一个 table 数据如下：

picture with data

我需要 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

但我很难合并第二个循环并将结果移动到我想要的位置。

感谢您的提示。

Answer 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

In my opinion, an additional output loop is unnecessary, it would be more correct to output the results in the same line as the processed value in the "BX" column for a visual comparison of the processed value and the result

选项 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

循环循环 - Vba

Loop in a Loop - Vba

vba

loops

nested-loops