时间戳

首页 > 解决方案 > 使用 InStr 或 Left/Right 检查反向循环中的变量

excel - 使用 InStr 或 Left/Right 检查反向循环中的变量

问题描述

在工作中，我有一项重复性任务，即查看帐户活动和更改列表，我必须删除我执行维护时不需要的空格和行。对于其中的 80%，我能够为每个循环工作一个非常不优雅但有效的循环。例子：

For Each c In ActiveSheet.UsedRange
If InStr(1, c.Value, SubString7) = 1 Then   ' find earn lines and remove
c.EntireRow.Offset(1).Delete
c.EntireRow.Clear
c.EntireRow.Offset(-1).Delete
End If

Next

子字符串是每种交易类型的描述性标题行。我遇到的问题是可变的，而其他的则不是。它可以是 9 行长或 6 行长，也可以是正数或负数，但每种可能性都带有相同的标题行。根据我能找到的一切试图弄清楚，我需要使用一个循环，从下到上移动。我无法使用 InStr 或左/右触发它。

这是我现在正在尝试的精简版本：

    lr = Range("A" & Rows.Count).End(xlUp).Row
        For rowcounter = lr To 0 Step -1
          If VBA.Strings.Left(Cells(rowcounter).Value, 11) Like "Earn Manual" Then
              If VBA.Strings.Left(Cells(rowcounter + 5).Value, 1) = "-" Then 
                  If VBA.Strings.Left(Cells(rowcounter + 6).Value, 3) = "AVG" Then 
                  Cells(rowcounter).EntireRow.Offset(5).Delete 'this, several more times with different offsets for the required lines
                  Else
                  Cells(rowcounter).EntireRow.Offset(5).Delete 'different ones, finalizing removals on the negative value items
                  End if
              Else
                  If VBA.Strings.Left(Cells(rowcounter + 6).Value, 3) = "AVG" Then
                  Cells(rowcounter).EntireRow.Offset(5).Delete 'again, but with different offsets
                  Else 'There is one line for these that I have to split into two lines, not sure if this will even work as I cannot get it to trigger
                  Cells(rowcounter).EntireRow.Offset(8).Delete
                  Cells(rowcounter).EntireRow.Offset(7).Delete
                  Cells(rowcounter + 4).Value = VBA.Strings.Right(Cells(rowcounter + 3).Value, 25)
                  Cells(rowcounter + 3).Value = VBA.Strings.Left(Cells(rowcounter + 3).Value, 13)
                  End if 
              End If
          End If

Next Rowcounter

我最初的第一条 If 行是：

If InStr(1, Cells(rowcounter).Value, SubString8) = 1 Then

我尝试切换到Left()和 Like 但仍然没有骰子。

尝试提供输入/输出样本

样本数据：
样本数据

A列的目标输出：

保留数据

再次更新，新的和改进的代码仍然失败：

Next
    For i = 1 To ActiveSheet.Range("A" & ActiveSheet.Rows.Count).End(xlUp).Row
        If ws.Range("A" & i) Like "Earn Manual*" Then
            If ws.c("A" & i + 5) Like "-*" Then
                If ws.c("A" & i + 6) Like "Avg*" Then
                    Set Deleteme = c.Range("A" & i, "A" & i + 8) ' shows AVG, negative value
                Else
                    Set Deleteme = c.Range("A" & i, "A" & i + 5) ' no AVG, negative value
                End If

            Else
                If ws.c("A" & i + 6) Like "Avg*" Then
                    Set Deleteme = c.Range("A" & i, "A" & i + 3)
                    Set Deleteme = c.Range("A" & i + 5)
                Else
                    Set Deleteme = c.Range("A" & i, "A" & i + 3)
                    Set Deleteme = c.Range("A" & i + 5)
                End If
            End If
        Else
            Set Deleteme = Union(Deleteme, ws.Range("A" & i))
        End If
Next A

标签： excelvba

解决方案

我无法做到 100% 正确，因为它基于 OP 的新改进代码，其逻辑存在一些缺陷。我的目标是简化整体语法，使其更容易正确。

使用偏移值删除的问题是这些值会在您身上移动。我的解决方案是联合所有要删除的行，然后在循环完成后删除它们。这不仅效率更高，而且允许我们从上到下循环。这使得代码更容易理解。

以这种方式联合范围时，必须先测试要删除的目标范围是否为Nothing。如果目标范围是 Nothing，我们将其设置为新范围，否则我们将两个范围合并。我写了一个子程序UnionRange()，这样每次我们需要做一个联合时我们就不必重复这个过程。

With块，Range.Offset()并Range.Resize()用于简单的语法。我觉得这比连接范围内的地址更干净（例如 Range("A" & i + 5) 和 Range("A" & i, "A" & i + 8)）。

Sub CleanUp()
    With ThisWorkbook.Worksheets("Sheet1")
        Dim r As Long
        Dim rUnion As Range
        For r = 1 To .Cells(.Rows.Count, 1).End(xlUp).Row
            With .Cells(r, 1)
                If .Value = "" Then
                    UnionRange rUnion, .Offset(0)
                ElseIf .Value Like "Earn Manual*" Then
                    If .Offset(6).Value Like "Avg*" Then    ' shows AVG, negative value
                        UnionRange rUnion, .Offset(8)
                    Else                              ' no AVG, negative value
                        UnionRange rUnion, .Offset(5)
                    End If
                Else
                    'This can't be right
                    If .Offset(6).Value Like "Avg*" Then 'If Like "Avg*" Then Delete These Cells
                        UnionRange rUnion, .Resize(3)
                        UnionRange rUnion, .Offset(5)
                    Else 'Hell If Not Like "Avg*" Then Delete The Same Cells Anyway
                        UnionRange rUnion, .Resize(3)
                        UnionRange rUnion, .Offset(5)
                    End If
                End If
            End With
        Next
    End With

    If Not rUnion Is Nothing Then
        Application.ScreenUpdating = False
        rUnion.EntireRow.Delete
    End If
End Sub

Sub UnionRange(ByRef rUnion As Range, ByRef Cell As Range)
    If rUnion Is Nothing Then
        Set rUnion = Cell
    Else
        Set rUnion = Union(rUnion, Cell)
    End If
End Sub

推荐阅读