VBA - если значение в sheet1 найдено в sheet2, то удалить данные из sheet2 - PullRequest
0 голосов
/ 15 апреля 2019

У меня есть 2 листа настройки: исключения и проблемы

Проблемы содержит список идентификаторов CASE и столбцы, в которых перечислены «проблемы»

Исключения будет заполнено идентификаторами CASE ID, которые должны быть исключены (и удалены) из листа вопросов.

У меня вопрос в 2 раза:

  1. Правильно ли обрабатывает мой текущий код этот код?Есть ли способы улучшить это?
  2. Есть ли способ, чтобы код циклически проходил по всем столбцам?Или просто проще скопировать цикл FOR / NEXT для каждого столбца на листе «Проблемы»?

Код ниже:

Sub Exclusions()

'find exclusions and remove from issues sheet. once done delete any completely blank row

Dim i As Long
Dim k As Long
Dim lastrow As Long
Dim lastrowex As Long
Dim DeleteRow As Long
Dim rng As Range

On Error Resume Next
    Sheets("Issues").ShowAllData
    Sheets("Exclusions").ShowAllData
On Error GoTo 0

Application.ScreenUpdating = False

lastrowex = Sheets("Exclusions").Cells(Rows.Count, "J").End(xlUp).Row

    With ThisWorkbook

        lastrow = Sheets("Issues").Cells(Rows.Count, "A").End(xlUp).Row

    For k = 2 To lastrowex
        For i = 2 To lastrow
            If Sheets("Exclusions").Cells(k, 10).Value <> "" Then
                If Sheets("Exclusions").Cells(k, 10).Value = Sheets("Issues").Cells(i, 1).Value Then
                    Sheets("Issues").Cells(i, 11).ClearContents
                End If
            End If
        Next i
    Next k

    End With


On Error Resume Next

For Each rng In Range("B2:P" & lastrow).Columns
    rng.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Next rng

Application.ScreenUpdating = True

End Sub

Формат данных:

Лист «Проблемы»

CASE ID      Issue 1     Issue 2    Issue 3
ABC123       No address  No Name    No Number

Лист «Исключения»

Issue 1    Issue 2    Issue 3
ABC123     DEF123     ABC123

Пример данных:

Лист проблем может содержать несколько идентификаторов CASE ID для одной или нескольких проблем,

CASE ID   Issue 1     Issue 2    Issue 3
DEF123    No add                 No num
PLZ                   No name

Лист исключений - это, по сути, метод, позволяющий кому-то «исключить» конкретную проблему по любой причине.Таким образом, если определено, что идентификатор PLZ CASE ID, не имеющий имени, в порядке, его следует исключить из списка проблем.

Issue 1      Issue 2     Issue 3
DEF123                   DEF123

PLZ не будет отображаться в приведенном выше примере, поскольку он находится на листе «ИСКЛЮЧЕНИЯ».

1 Ответ

1 голос
/ 15 апреля 2019

VBAWARD Сделайте копию своих данных перед тем, как использовать этот код:

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

Option Explicit

Sub Exclusions()

'find exclusions and remove from issues sheet. once done delete any completely blank row

    ' Declare objects
    Dim issuesRange As Range
    Dim exclusionsRange As Range
    Dim issuesCell As Range
    Dim exclusionsCell As Range

    ' Declare other variables
    Dim lastRowIssues As Long
    Dim lastRowExclusions As Long


    ' This is not recommended
    On Error Resume Next
        Sheets("Issues").ShowAllData
        Sheets("Exclusions").ShowAllData
    On Error GoTo 0

    Application.ScreenUpdating = False


    ' Get the last row in the exclusions sheet - In this case I'd prefer to work with structured tables
    lastRowExclusions = ThisWorkbook.Worksheets("Exclusions").Cells(Rows.Count, "J").End(xlUp).Row ' use full identifier with ThisWorkbook. and also use Worksheets collection as you don't need to look for graphics sheets

    ' Get the last row in the issues sheet - In this case I'd prefer to work with structured tables
    lastRowIssues = ThisWorkbook.Worksheets("Issues").Cells(Rows.Count, "A").End(xlUp).Row

    ' Store Exclusions in a range
    Set exclusionsRange = ThisWorkbook.Worksheets("Exclusions").Range("J2:L" & lastRowExclusions)

    ' Store Issues in a range
    Set issuesRange = ThisWorkbook.Worksheets("Issues").Range("A2:C" & lastRowIssues)

    ' Loop through each of the exclusions
    For Each exclusionsCell In exclusionsRange

        ' Loop through each of the Issues Cells
        For Each issuesCell In issuesRange

            ' Compare if ex is equal to iss
            If exclusionsCell.Value = issuesCell Then

                ' Color the cell or clear its contents
                'issuesCell.Interior.Color = 255

                ' Clear the cell contents
                 issuesCell.ClearContents

                ' Delete the whole row?
                'issuesCell.Rows.EntireRow.Delete

                ' Delete the row if it's empty
                If WorksheetFunction.CountA(ThisWorkbook.Worksheets("Issues").Range("B" & issuesCell.Row & ":D" & issuesCell.Row).Value) = 0 Then
                    issuesCell.Rows.EntireRow.Delete
                End If

            End If

        Next issuesCell

    Next exclusionsCell

    ' Restore settings
    Application.ScreenUpdating = True

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