Блог

Главная - Вопросы по программированию - Удалить строки, если совпадают два критерия

Удалить строки, если совпадают два критерия

#excel #vba

#excel #vba

Вопрос:

У меня есть два листа с данными, и я хотел бы удалить строки на листе 1, если совпадают два критерия. Я составил мысленную карту идеи, чтобы ее было легче понять.

введите описание изображения здесь

Я выполнил самую первую часть кода, которая удаляет строки при совпадении одного критерия, но она также удаляет пустые строки, которые я хотел сохранить.

 Private Sub CommandButton1_Click()

Application.ScreenUpdating = False

Dim iListCount As Long
Dim x As Variant
Dim iCtr As Long

iListCount = Sheets("Sheet1").Cells(Rows.Count, "N").End(xlUp).Row

For Each x In Sheets("Laoseis").Range("B4:B" amp; Sheets("Sheet1").Cells(Rows.Count, "N").End(xlUp).Row)
  For iCtr = iListCount To 16 Step -1
    If x.Value = Sheets("Sheet1").Cells(iCtr, 14).Value Then
      Sheets("Sheet1").Cells(iCtr, 14).EntireRow.Delete
    End If
  Next iCtr
Next
Application.ScreenUpdating = True

End Sub

Комментарии:

1. Вы можете указать условие И в своем if (или несколько), что-то вроде If x.Value = Sheets("Sheet1").Cells(iCtr, 14).Value amp; x.Value <> "" Then Sheets("Sheet1").Cells(iCtr, 14).EntireRow.Delete (если у вас есть только одна строка в вашем if, которую нужно выполнить, вы можете поместить ее в ту же строку и закончить, если это не обязательно). Я не полностью прочитал ваш код и логику, но чтобы применить 2 условия к тому, что у вас там есть, вот как я бы к этому подошел.

Ответ №1:

Я думаю, вы можете использовать следующее:

 Option Explicit

Private Sub CommandButton1_Click()

    Dim iListCount As Long, iCtr As Long
    Dim cell As Range

    Application.ScreenUpdating = False

    With ThisWorkbook

        iListCount = .Sheets("Sheet1").Cells(Rows.Count, "N").End(xlUp).Row

        For Each cell In .Sheets("Laoseis").Range("B4:B" amp; iListCount)

          For iCtr = iListCount To 16 Step -1

            If cell.Value = .Sheets("Sheet1").Cells(iCtr, 14).Value And cell.Value <> "" Then
                .Sheets("Sheet1").Cells(iCtr, 14).EntireRow.Delete
            End If

          Next iCtr

        Next cell

    End With

    Application.ScreenUpdating = True

End Sub