如何更新范围内的测试循环更改范围

Posted 2021-04-09

我希望我的循环测试正在寻找值的单元格。问题是我的范围正在改变，因为循环正在添加行。如何更新我的设定范围？

WorkRng1和WorkRng2是使用输入框设置的公共变量

到目前为止，这是我的代码：

Dim foundRange As Range
Dim manualRng As Range
Dim LastRow As Long
matchCounter = 0
On Error Resume Next
Application.ScreenUpdating = False
    For Each Rng2 In WorkRng2
        If Rng2.Interior.Color = VBA.RGB(255, 0, 0) And Rng2.Value > 0 Then
                blkRow.Copy
            LastRow = Range(WorkRng1.Column & Rows.Count).End(xlUp).Row 'tests for last filled row in range 1
            Set foundRange = WorkRng1.Find(Rng2.Offset(-1, 0).Value, LookIn:=xlValues)
            If foundRange Is Nothing Then
            Application.ScreenUpdating = True
                MsgBox "Cannot find where to put " & Rng2, vbInformation, "OOPS!"
                Set manualRng = Application.InputBox("Please select the cell where you would like to add " & Rng2, "LOCATION PLEASE", Type:=8)
                manualRng.Select
                Selection.EntireRow.Insert Shift:=xlDown
                    Application.CutCopyMode = False
            Application.ScreenUpdating = False
                Else
            WorkRng1.Find(Rng2.Offset(-1, 0).Value, LookIn:=xlValues).Select
                ActiveCell.Offset(1, 0).Select
                Selection.EntireRow.Insert Shift:=xlDown
                    Application.CutCopyMode = False
            End If

我在想我会添加一个lastRow测试，但我仍然坚持该范围的语法。任何帮助将不胜感激。

答案

对于那些感兴趣的人，我通过将找到的范围设置为整列来解决这个问题。这是我的工作代码：

Dim matchCounter As Integer
Dim foundRange As Range
Dim manualRng As Range
Dim lastRow As Long
matchCounter = 0
On Error Resume Next
Application.ScreenUpdating = False
    For Each Rng2 In WorkRng2
        If Rng2.Interior.Color = VBA.RGB(255, 0, 0) And Rng2.Value > 0 Then
                blkRow.Copy
            lastRow = WorkRng1.SpecialCells(xlCellTypeLastCell).Row 'tests for last filled row in range 1
            Set foundRange = Range(Cells(1, WorkRng1.Column), Cells(lastRow, WorkRng1.Column)).Find(Rng2.Offset(-1, 0).Value, LookIn:=xlValues)
            If foundRange Is Nothing Then
            Application.ScreenUpdating = True
                MsgBox "Cannot find where to put " & Rng2, vbInformation, "OOPS!"
                Set manualRng = Application.InputBox("Please select the cell where you would like to add " & Rng2, "LOCATION PLEASE", Type:=8)
                blkRow.Copy
                manualRng.Select
                Selection.EntireRow.Insert Shift:=xlDown
                    Application.CutCopyMode = False
            Application.ScreenUpdating = False
                Else
            WorkRng1.Find(Rng2.Offset(-1, 0).Value, LookIn:=xlValues).Select
                ActiveCell.Offset(1, 0).Select
                Selection.EntireRow.Insert Shift:=xlDown
                    Application.CutCopyMode = False
            End If