Question

很难在标题中解释。我试图理解为什么代码中的小变化会导致excel崩溃

想法是，找到具有值的单元格的特定位置＆＃34; test＆＃34;，检查上面的行是否为空，如果它为空则删除它。如果不是空的，那么测试它上面的行等等。

初始工作代码

Sub testcode()

**Dim test As Boolean**
Dim rCell As Range
Dim rRange As Range
Dim Row1 As Integer
Dim rshift As Integer

Range("E508").Select
Do Until ActiveCell.Value = "test"
        ActiveCell.Offset(1).Select
Loop

Row1 = 0
Row1 = ActiveCell.Row

rshift = 0
Do While Row1 > 626
    Set rRange = Range("A" & (Row1 - 1 - rshift) & ":" & "AD" & (Row1 - 1 - rshift))
    **test = 0**
    For Each rCell In rRange
        If Not IsEmpty(rCell.Value) Then
            rshift = rshift + 1
            **test = 1**
            Exit For
        End If
    Next rCell
    **If test = 0 Then**
        Rows((Row1 - 1 - rshift)).EntireRow.Delete
        Row1 = Row1 - 1
    End If
Loop

End Sub

Vs以上。导致Excel崩溃的代码。我只更改了test测试中的初始if then变量值和条件

Sub testcode()

**Dim test As Boolean**
Dim rCell As Range
Dim rRange As Range
Dim Row1 As Integer
Dim rshift As Integer

Range("E508").Select
Do Until ActiveCell.Value = "test"
        ActiveCell.Offset(1).Select
Loop

Row1 = 0
Row1 = ActiveCell.Row

rshift = 0
Do While Row1 > 626
    Set rRange = Range("A" & (Row1 - 1 - rshift) & ":" & "AD" & (Row1 - 1 - rshift))
    **test = 1**
    For Each rCell In rRange
        If Not IsEmpty(rCell.Value) Then
            rshift = rshift + 1
            **test = 0**
            Exit For
        End If
    Next rCell
    **If test = 1 Then**
        Rows((Row1 - 1 - rshift)).EntireRow.Delete
        Row1 = Row1 - 1
    End If
Loop

End Sub

感谢您提供任何面包屑知识

Answer 1

请在下面找到更多功能的代码，您将能够轻松适应您的需求。我将第一个Do Loop替换为Match函数以缩短运行时间，因为最好避免使用Select。

Option Explicit

Sub testcode()

Dim test As Boolean
Dim rCell As Range
Dim rRange As Range
Dim Row1 As Long
Dim rshift As Long
Dim efirstRow As Long
Dim elastRow As Long

' set first row on Column E, in this example E508
efirstRow = Range("E508").Row

' set last row on Column E, in this example E2000, modify it to your needs
elastRow = Range("E2000").Row

' find first row match where "test" is found and add the efirstRow reference
Row1 = efirstRow + WorksheetFunction.Match("test", Range(Cells(efirstRow, "E"), Cells(elastRow, "E")), 0) - 1
rshift = 0

Do While Row1 > 626
    Set rRange = Range("A" & (Row1 - 1 - rshift) & ":" & "AD" & (Row1 - 1 - rshift))
    test = True

    For Each rCell In rRange
        If Not IsEmpty(rCell.Value) Then
            rshift = rshift + 1
            test = False
            Exit For
        End If
    Next rCell

    If test Then
        Rows((Row1 - 1 - rshift)).EntireRow.Delete
        Row1 = Row1 - 1
    End If
Loop

寻求解释 - 代码的微小变化使VBA脱颖而出

1 个答案: