嵌套循环不起作用,无法退出内循环

时间:2017-01-08 08:21:31

标签: excel-vba nested-loops vba excel

我尝试使用一个定义的范围来循环一个自动过滤器来复制数据然后循环遍历一个范围数组,我想粘贴数据值。

当内循环继续执行并且所有范围都具有相同的值时,我会遇到问题。

认为我不知何故需要将其浓缩为1循环但是对于我的生活无法弄清楚如何在同一循环中将两者一起增加?

Sub TrendTables()

Dim rng As Range, dailyTrendrng As Long, c As Range
Dim lastrow As Long

Dim aTrendRng(1 To 16) As Range

Set aTrendRng(1) = Sheets("Daily Trends").Range("A2")
Set aTrendRng(2) = Sheets("Daily Trends").Range("K2")
Set aTrendRng(3) = Sheets("Daily Trends").Range("A29")
Set aTrendRng(4) = Sheets("Daily Trends").Range("K29")
Set aTrendRng(5) = Sheets("Daily Trends").Range("A56")
Set aTrendRng(6) = Sheets("Daily Trends").Range("K56")
Set aTrendRng(7) = Sheets("Daily Trends").Range("A83")
Set aTrendRng(8) = Sheets("Daily Trends").Range("K83")
Set aTrendRng(9) = Sheets("Daily Trends").Range("A110")
Set aTrendRng(10) = Sheets("Daily Trends").Range("K110")
Set aTrendRng(11) = Sheets("Daily Trends").Range("A137")
Set aTrendRng(12) = Sheets("Daily Trends").Range("K137")
Set aTrendRng(13) = Sheets("Daily Trends").Range("A164")
Set aTrendRng(14) = Sheets("Daily Trends").Range("K164")
Set aTrendRng(15) = Sheets("Daily Trends").Range("A191")
Set aTrendRng(16) = Sheets("Daily Trends").Range("K191")


'clear ranges on Daily Trends tab
Set rng = Sheets("Daily Trends").Range("A2:S24, A29:S51, A56:S78, A83:S105, A110:S132, A137:S159, A164:S186, A191:S213")
rng.ClearContents

'turn off any previous filters
If Sheets("daily dump").AutoFilterMode Then
    Sheets("daily dump").AutoFilter.Range.AutoFilter
End If


With Sheets("daily dump")
    lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
End With

Set c = Sheets("mapping").Range("BG1:BG16")

For Each c In Sheets("mapping").Range("BG1:BG16")

Sheets("daily dump").Range("A4:P" & lastrow).AutoFilter Field:=4, Criteria1:="=" & c.Value
Sheets("daily dump").Range("A4:P" & lastrow).SpecialCells(xlCellTypeVisible).Copy

    For dailyTrendrng = LBound(aTrendRng) To UBound(aTrendRng)
        aTrendRng(dailyTrendrng).PasteSpecial xlValues
    Next


''''''this is where i want to go back to my first "FOR LOOP"


Next

End Sub

1 个答案:

答案 0 :(得分:0)

如果您确信复制的范围始终适合27行x 10列目标区域,则以下代码已重构为仅使用单个循环:

Sub TrendTables()

    Dim rng As Range, dailyTrendrng As Long, c As Range
    Dim lastrow As Long
    Dim mappingRow As Long
    Dim aTrendRng As Variant

    aTrendRng = Array("A2", "K2", _
                      "A29", "K29", _
                      "A56", "K56", _
                      "A83", "K83", _
                      "A110", "K110", _
                      "A137", "K137", _
                      "A164", "K164", _
                      "A191", "K191")

    'clear ranges on Daily Trends tab
    Set rng = Worksheets("Daily Trends").Range("A2:S24, A29:S51, A56:S78, A83:S105, A110:S132, A137:S159, A164:S186, A191:S213")
    rng.ClearContents

    With Worksheets("daily dump")
        'turn off any previous filters
        If .AutoFilterMode Then
            .AutoFilter.Range.AutoFilter
        End If

        lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row

        mappingRow = 1
        For dailyTrendrng = LBound(aTrendRng) To UBound(aTrendRng)
            'This line could be used if we wanted to get rid of "mappingRow", but
            'it's a bit harder to understand
            '.Range("A4:P" & lastrow).AutoFilter Field:=4, Criteria1:="=" & Worksheets("mapping").Range("BG" & (dailyTrendrng - LBound(aTrendRng) + 1)).Value
            'so we will use the following line instead
            .Range("A4:P" & lastrow).AutoFilter Field:=4, Criteria1:="=" & Worksheets("mapping").Range("BG" & mappingRow).Value
            .Range("A4:P" & lastrow).SpecialCells(xlCellTypeVisible).Copy
            Worksheets("Daily Trends").Range(aTrendRng(dailyTrendrng)).PasteSpecial xlValues

            mappingRow = mappingRow + 1
        Next
    End With

End Sub

主要变化是:

  • 我创建了一个额外的变量(mappingRow)来指向“映射”表中的每个单元格。 (我包含了一个注释掉的行,它可以在没有额外变量的情况下实现相同的功能,但使用额外的变量可能更容易理解。)这是唯一需要真正才能实现的变化想要的。

  • 我只存储了16个目标范围地址,而不是16个不同的范围对象。这似乎更容易维持这种方式。

  • 我将Rows.Count更改为.Rows.Count,以便它引用“daily_dump”表而不是活动表。

  • 我在任何地方使用Worksheets而不是Sheets - Sheets集合包含Chart张,所以通常更好的做法是专门提到{{1当您知道您正在使用Worksheets时,只有当您不确定它是WorksheetSheets时才使用Worksheet您正在引用。