For循环没有按预期工作，但没有给出任何错误

Question

unused_row = report.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

For Each rng In export.Range("D1:D600")
If Not IsEmpty(rng) Then
Set ferie = rng.Offset(0, 17)
Set permessi = rng.Offset(1, 17)
Set flessibilita = rng.Offset(2, 17)
ferie.Copy report.Range("b" & unused_row)
permessi.Copy report.Range("c" & unused_row)
flessibilita.Copy report.Range("d" & unused_row)
End If
Next

我有下面的代码没有按预期工作。它应该循环遍历export.Range("D1:D600")中的每个单元格，并在另一个工作表的B到D列上复制(使用最近未使用的行不覆盖数据)从循环到达的位置的偏移量中指定的值，用rng指定。

代码运行没有任何错误，但不复制所需的数据。

任何想法?

Answer 1

复制到其他工作表

• Export和Report是工作簿中包含此代码的两个工作表的代码名称。
• 要复制到下一行，您必须在If语句的末尾执行unused_row = unused_row + 1。
• 我选择使用单元格范围并在循环开始时将其抵消作为替代方案。
• 如果你把...End(xlup)...行放在循环中(不推荐)，那么你必须确保它在第2列("B")上计算，因为你没有写到第1列("A")。
• 这三个"中间"范围变量似乎有点没用。参见测试2-4，不带它们。

Option Explicit
Sub Test1() ' copy values, formats and formulas

Dim dCell As Range: Set dCell = Report.Cells(Report.Rows.Count, "B") _
.End(xlUp) ' last occupied destination cell

Dim ferie As Range, permessi As Range, flessibilita As Range
Dim sCell As Range

For Each sCell In Export.Range("D1:D600").Cells
If Not IsEmpty(sCell) Then
Set dCell = dCell.Offset(1) ' next destination cell
With sCell
Set ferie = .Offset(0, 17)
Set permessi = .Offset(1, 17)
Set flessibilita = .Offset(2, 17)
End With
With dCell
ferie.Copy .Offset(, 0)
permessi.Copy .Offset(, 1)
flessibilita.Copy .Offset(, 2)
End With
End If
Next
End Sub
Sub Test2() ' copy values, formats and formulas

Dim dCell As Range: Set dCell = Report.Cells(Report.Rows.Count, "B") _
.End(xlUp) ' last occupied destination cell

Dim sCell As Range

For Each sCell In Export.Range("D1:D600").Cells
If Not IsEmpty(sCell) Then
Set dCell = dCell.Offset(1) ' next destination cell
sCell.Offset(0, 17).Copy dCell.Offset(, 0)
sCell.Offset(1, 17).Copy dCell.Offset(, 1)
sCell.Offset(2, 17).Copy dCell.Offset(, 2)
End If
Next sCell
End Sub
Sub Test3() ' copy only values; more efficient

Dim dCell As Range: Set dCell = Report.Cells(Report.Rows.Count, "B") _
.End(xlUp) ' last occupied destination cell

Dim sCell As Range

For Each sCell In Export.Range("D1:D600").Cells
If Not IsEmpty(sCell) Then
Set dCell = dCell.Offset(1) ' next destination cell
dCell.Offset(, 0).Value = sCell.Offset(0, 17).Value
dCell.Offset(, 1).Value = sCell.Offset(1, 17).Value
dCell.Offset(, 2).Value = sCell.Offset(2, 17).Value
End If
Next sCell
End Sub
Sub Test4() ' copy only values shorter; more efficient

Dim dCell As Range: Set dCell = Report.Cells(Report.Rows.Count, "B") _
.End(xlUp) ' last occupied destination cell

Dim sCell As Range
Dim i As Long

For Each sCell In Export.Range("D1:D600").Cells
If Not IsEmpty(sCell) Then
Set dCell = dCell.Offset(1) ' next destination cell
For i = 0 To 2
dCell.Offset(, i).Value = sCell.Offset(i, 17).Value
Next i
End If
Next sCell
End Sub