VBA Excel 2007:循环插入错误的位置行。
VBA Excel 2007: Loops insert on the wrong place rows.
我写了两个循环来比较 2 个列表,并将一个列表中缺失的信息插入到另一个列表中。
不幸的是,宏在运行时中间仅插入第一行下方的行。我试图用 If 语句避免这种情况,但错误将从第二行开始。
代码如下:
Sub CopyData()
Dim dl_length As Integer
Dim oa_length As Integer
Dim dl_count As Integer
Dim oa_count As Integer
dl_length = Worksheets("download").Cells(Rows.Count, 1).End(xlUp).Row + 1
oa_length = Worksheets("overall").Cells(Rows.Count, 1).End(xlUp).Row + 1
For dl_count = 1 To dl_length
For oa_count = 1 To oa_length
If Worksheets("download").Range("F" & dl_count) = Worksheets("overall").Range("C" & oa_count) Then
Worksheets("overall").Range("C" & oa_count).Select
ActiveCell.Offset(1).EntireRow.Insert
Worksheets("overall").Range("A" & oa_count + 1) = "Search and replace"
Worksheets("overall").Range("E" & oa_count + 1) = Worksheets("download").Range("L" & dl_count)
End If
oa_length = Worksheets("overall").Cells(Rows.Count, 1).End(xlUp).Row + 1
Next oa_count
Next dl_count
End Sub
当我尝试
你能帮我改进代码吗?
替换
Worksheets("overall").Range("C" & oa_count).Select
ActiveCell.Offset(1).EntireRow.Insert
与
With Worksheets("overall").Range("C" & oa_count).Offset(1,0).EntireRow.Insert
关于 ActiveCell
的一点点来自 MSDN 的好家伙:
Returns a Range object that represents the active cell in the active
window (the window on top) or in the specified window. If the window
isn't displaying a worksheet, this property fails. Read-only.
插入一行时,不需要oa_length = Worksheets("overall").Cells(Rows.Count, 1).End(xlUp).Row + 1
相反,oa_length = oa_length + 1
会工作得更快。
也应该在End if
之前。
但仍然更新 oa_length 不会使 For
循环再多一行。
您必须为此目的使用 While
或 repeat until
循环。
Option Explicit
Sub CopyData()
Dim dl_length&
Dim oa_length&
Dim dl_count&
Dim oa_count&
Dim Sh_oa As Worksheet
Dim Sh_dl As Worksheet
With ThisWorkbook
Set Sh_oa = .Sheets("overall")
Set Sh_dl = .Sheets("download")
End With
With Sh_oa
oa_length = .Cells(.Rows.Count, 1).End(xlUp).Row 'i removed the +1, wich is a blank cell
End With
With Sh_dl
dl_length = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
With Application 'this part is to make things faster...
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
For dl_count = 1 To dl_length
While oa_count <= oa_length
oa_count = oa_count + 1
If Sh_dl.Range("F" & dl_count).Value2 = Sh_oa.Range("C" & oa_count).Value2 Then
oa_count = oa_count + 1 'if you insert a line, you'll need to read a line after that later
With Sh_oa
.Rows(oa_count).Insert
.Cells(oa_count, 1).Value2 = "Search and replace"
.Range("E" & oa_count).Value2 = Sh_dl.Range("L" & dl_count).Value2
End With
oa_length = oa_length + 1 'wider the scope of checks
End If
Wend
Next dl_count
Set Sh_oa = Nothing
Set Sh_dl = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub
我写了两个循环来比较 2 个列表,并将一个列表中缺失的信息插入到另一个列表中。 不幸的是,宏在运行时中间仅插入第一行下方的行。我试图用 If 语句避免这种情况,但错误将从第二行开始。
代码如下:
Sub CopyData()
Dim dl_length As Integer
Dim oa_length As Integer
Dim dl_count As Integer
Dim oa_count As Integer
dl_length = Worksheets("download").Cells(Rows.Count, 1).End(xlUp).Row + 1
oa_length = Worksheets("overall").Cells(Rows.Count, 1).End(xlUp).Row + 1
For dl_count = 1 To dl_length
For oa_count = 1 To oa_length
If Worksheets("download").Range("F" & dl_count) = Worksheets("overall").Range("C" & oa_count) Then
Worksheets("overall").Range("C" & oa_count).Select
ActiveCell.Offset(1).EntireRow.Insert
Worksheets("overall").Range("A" & oa_count + 1) = "Search and replace"
Worksheets("overall").Range("E" & oa_count + 1) = Worksheets("download").Range("L" & dl_count)
End If
oa_length = Worksheets("overall").Cells(Rows.Count, 1).End(xlUp).Row + 1
Next oa_count
Next dl_count
End Sub
当我尝试
你能帮我改进代码吗?
替换
Worksheets("overall").Range("C" & oa_count).Select
ActiveCell.Offset(1).EntireRow.Insert
与
With Worksheets("overall").Range("C" & oa_count).Offset(1,0).EntireRow.Insert
关于 ActiveCell
的一点点来自 MSDN 的好家伙:
Returns a Range object that represents the active cell in the active window (the window on top) or in the specified window. If the window isn't displaying a worksheet, this property fails. Read-only.
插入一行时,不需要oa_length = Worksheets("overall").Cells(Rows.Count, 1).End(xlUp).Row + 1
相反,oa_length = oa_length + 1
会工作得更快。
也应该在End if
之前。
但仍然更新 oa_length 不会使 For
循环再多一行。
您必须为此目的使用 While
或 repeat until
循环。
Option Explicit
Sub CopyData()
Dim dl_length&
Dim oa_length&
Dim dl_count&
Dim oa_count&
Dim Sh_oa As Worksheet
Dim Sh_dl As Worksheet
With ThisWorkbook
Set Sh_oa = .Sheets("overall")
Set Sh_dl = .Sheets("download")
End With
With Sh_oa
oa_length = .Cells(.Rows.Count, 1).End(xlUp).Row 'i removed the +1, wich is a blank cell
End With
With Sh_dl
dl_length = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
With Application 'this part is to make things faster...
.ScreenUpdating = False
.EnableEvents = False
.Calculation = xlCalculationManual
End With
For dl_count = 1 To dl_length
While oa_count <= oa_length
oa_count = oa_count + 1
If Sh_dl.Range("F" & dl_count).Value2 = Sh_oa.Range("C" & oa_count).Value2 Then
oa_count = oa_count + 1 'if you insert a line, you'll need to read a line after that later
With Sh_oa
.Rows(oa_count).Insert
.Cells(oa_count, 1).Value2 = "Search and replace"
.Range("E" & oa_count).Value2 = Sh_dl.Range("L" & dl_count).Value2
End With
oa_length = oa_length + 1 'wider the scope of checks
End If
Wend
Next dl_count
Set Sh_oa = Nothing
Set Sh_dl = Nothing
With Application
.ScreenUpdating = True
.EnableEvents = True
.Calculation = xlCalculationAutomatic
End With
End Sub