Удаляет заголовки при удалении строк с разными критериями - PullRequest
0 голосов
/ 14 февраля 2020

У меня есть проблема при удалении строк с определенными условиями, потому что он также удаляет мои заголовки, а также есть ли способ улучшить удаление строк с другими критериями?

Sub RO_FilterDelete()
Dim RowToTest As Long

For RowToTest = Cells(Rows.Count, 2).End(xlUp).row To 2 Step -1

With Cells(RowToTest, 1)
    If .Value <> "ONLINE" _
    Then _
    Rows(RowToTest).EntireRow.Delete
End With

Next RowToTest

Dim RowToTest2 As Long

For RowToTest2 = Cells(Rows.Count, 2).End(xlUp).row To 2 Step -1

With Cells(RowToTest2, 6)
    If .Value <> "CONFIRMACIÓN DE INFORMACIÓN DE CONTRATO" _
    And .Value <> "ACTUALIZACIÓN DE INFORMACIÓN DE CONTRATO" _
    Then _
    Rows(RowToTest2).EntireRow.Delete
End With

Next RowToTest2
End Sub

Ошибка возникает из-за макрос, который вставляет данные в лист, вставляет их из A1 вместо A2, поэтому фильтр не работает.

Sub RechazosOnline()
Dim rsh As Worksheet, wb As Workbook
Dim wbCopyFrom As Workbook, wsCopyFrom As Worksheet

Set wb = Workbooks("2. Detalle_Transacciones_pendientes_rechazadas_MDM_27Ene20.xlsx")
Set wbCopyFrom = Workbooks("1. ReporteGeneral_TransaccionesDiariasMDM_20200115")
Set wsCopyFrom = wbCopyFrom.Worksheets("Detalle")
wsCopyFrom.Range("A2:I" & wsCopyFrom.Range("A" & Rows.Count).End(xlUp).row).Copy

For Each rsh In wb.Sheets
         rsh.Range("A2:I" & rsh.Range("A" & rsh.Cells.Rows.Count).End(xlUp).row).PasteSpecial xlPasteValues
     Next
End Sub

Ответы [ 2 ]

0 голосов
/ 14 февраля 2020

Использование метода объединения удобно и быстро.

Sub test()
    Dim rngU As Range, Rng As Range
    Dim rngDB As Range

    Set rngDB = Range("a2", Range("a" & Rows.Count).End(xlUp))

    For Each Rng In rngDB
        If Rng <> "ONLINE" Then
            If rngU Is Nothing Then
                Set rngU = Rng
            Else
                Set rngU = Union(Rng, rngU)
            End If
        End If
    Next Rng

    If Not rngU Is Nothing Then
        rngU.EntireRow.Delete
    End If

    Set rngU = Nothing
    Set rngDB = Range("b2", Range("b" & Rows.Count).End(xlUp))

    For Each Rng In rngDB
        If Not (Rng.Value = "CONFIRMACION DE INFORMACION DE CONTRATO" Or Rng.Value = "ACTUALIZACION DE INFORMACION DE CONTRATO") Then
            If rngU Is Nothing Then
                Set rngU = Rng
            Else
                Set rngU = Union(Rng, rngU)
            End If
        End If
    Next Rng

    If Not rngU Is Nothing Then
        rngU.EntireRow.Delete
    End If

End Sub
0 голосов
/ 14 февраля 2020

Оба l oop вашего кода работают на меня. Как предположил Вариат, возможно, ваш заголовок не в первом ряду.

Хорошего дня!

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...