Question

尝试删除包含少于2个字符的单元格的行。范围（＆＃34; A1＆＃34;）行突出显示，我不明白为什么。我可以在没有线路的情况下运行它，并且由于某种原因它会删除所有内容任何建议非常感谢。这是代码：

Option Explicit

Sub way()

Dim cell As Range

Range(“A1").CurrentRegion.activate

For Each cell In Selection

    If Len(cell) < 2 Then Selection.EntireRow.Delete

Next cell

End Sub

Answer 1

试一试

Sub mysub()
    Dim r As Range
    Dim i As Double
    Dim rcount as Double
    Dim mybool As Boolean

    Set r = Range("A1").CurrentRegion

    i = 1
    mybool = False

    Do
        rcount = r.Rows.count
        For j = 1 To r.Columns.count
            If Len(Cells(i, j).Value) < 2 Then
                Rows(i).Delete
                If rcount = 1 then Exit Sub
                mybool = True
                Exit For
            End If
        Next j
        If mybool = False Then i = i + 1
        mybool = False
    Loop While i <= rcount

End Sub

编辑：只是为了详细说明为什么我在这里全部提供了一个新代码 - 原始代码背后的逻辑实际上是有缺陷的。

例如考虑如果范围涉及以下连续行

会发生什么

     A     B     C      D     E
 1   ee    e     eee    ee    eee
 2   f     fff   fff    ff    ff

您的代码将从左到右从上到下逐行探索每个单元格。所以在这个例子中：

到达B1时，将删除第1行，第2行将移至第1行
从那里开始，你的循环将从单元格C1中取出 - 而不是A1。换句话说，它将错过探索单元格A1的值，该值应该限定删除行

Answer 2

使用AutoFilter

可以避免慢速循环

此代码

计算出A1
在下一列中添加一个数组公式，检查每行中所有单元格的长度，=MIN(LEN(A1:C1))<2
AutoFilter会删除True结果

enter image description here

码

Sub NoLoops()
Dim rng1 As Range
Dim rng2 As Range
Set rng1 = Range("A1").CurrentRegion
Set rng2 = Range(Cells(1, rng1.Columns.Count + 1), Cells(rng1.Rows.Count, rng1.Columns.Count + 1))
ActiveSheet.AutoFilterMode = False
With rng2
    .Formula = "=MIN(LEN(RC[-" & rng1.Columns.Count & "]:RC[-1]))<2"
    .FormulaArray = .FormulaR1C1
    .Value = .Value
    .AutoFilter Field:=1, Criteria1:="TRUE"
    .EntireRow.Delete
End With
ActiveSheet.AutoFilterMode = False
End Sub

Answer 3

Sub way()

Dim Cell As Range
For Each Cell In Range("A1").CurrentRegion
    If Len(Cell) < 2 Then Cell.EntireRow.Delete
Next Cell

End Sub

Answer 4

@IAmDranged是正确的，当你删除一行时，下一行将向上移动并成为当前行。然后Next cell行将遍历此行并移至下一行，而不检查任何单元格的长度是否少于2个字符。

另一种方法是将Delete方法保留到找到少于2个字符的单元格之后：

Sub way()

Dim cell As Range
Dim deleteRange As Range 'This will be used to store the Cells found

Range("A1").CurrentRegion.Activate

For Each cell In Selection

    If Len(cell) < 2 Then

        If deleteRange Is Nothing Then
            ' If this is the first cell found, then Set deleteRange to this cell
            Set deleteRange = cell
        Else
            ' Any cells found after the first, we can use the
            ' Union method to add it to the deleteRange
            Set deleteRange = Application.Union(cell, deleteRange)
        End If

    End If

Next cell

' Once all cells have been found, then Delete
deleteRange.Delete

End Sub

根据字符长度删除行

4 个答案: