我尝试使用一个定义的范围来循环一个自动过滤器来复制数据然后循环遍历一个范围数组,我想粘贴数据值。
当内循环继续执行并且所有范围都具有相同的值时,我会遇到问题。认为我不知何故需要将其浓缩为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
答案 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
时,只有当您不确定它是Worksheet
或Sheets
时才使用Worksheet
您正在引用。