Использование InStr или Left / Right для проверки переменных в обратном цикле

Question

На работе у меня есть повторяющаяся задача - просмотреть список действий в учетной записи и внести изменения, в которых я должен удалить пробелы и строки, которые не нужны для обслуживания, которое я выполняю.Для 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 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

Answer 1

Я не могу сделать это на 100% правильным, потому что он основан на новом и улучшенном коде OP, который имеет некоторые недостатки в своей логике.Моя цель состояла в том, чтобы просто использовать общий синтаксис, чтобы было легче разобраться.

Проблема с удалением со значениями смещения заключается в том, что значения перемещаются на вас.Мое решение состоит в том, чтобы объединить все строки, которые будут удалены, и затем удалить их после завершения цикла.Это не только более эффективно, но и позволяет нам зацикливаться сверху вниз.Это значительно упрощает выполнение кода.

Когда диапазон таким образом объединяется, вы должны сначала проверить, является ли целевой диапазон, который должен быть удален, пустым.Если целевым диапазоном является 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