Excel VBA-如果在sheet2中找到sheet1中的值,则从sheet2中删除数据

Excel VBA-如果在sheet2中找到sheet1中的值,则从sheet2中删除数据,excel,vba,loops,Excel,Vba,Loops,我有两张表格设置:排除和问题 “问题”具有案例ID列表和列出问题的列 排除项将填充要从问题表中排除和删除的案例ID Issue 1 Issue 2 Issue 3 DEF123 DEF123 我的问题有两个: 我当前的代码是否正确处理了这个问题?有什么方法可以改进这一点吗? 有没有办法让代码在所有列中动态循环?还是更容易为问题表上的每一列复制FOR/NEXT循环? 代码如下: Sub Exclusions() 'find exclusio

我有两张表格设置:排除和问题

“问题”具有案例ID列表和列出问题的列

排除项将填充要从问题表中排除和删除的案例ID

Issue 1      Issue 2     Issue 3
DEF123                   DEF123
我的问题有两个:

我当前的代码是否正确处理了这个问题?有什么方法可以改进这一点吗? 有没有办法让代码在所有列中动态循环?还是更容易为问题表上的每一列复制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
除外条款表

Issue 1    Issue 2    Issue 3
ABC123     DEF123     ABC123
数据示例:

对于一个或多个问题,问题表可能有多个案例ID

CASE ID   Issue 1     Issue 2    Issue 3
DEF123    No add                 No num
PLZ                   No name
排除表基本上是某人出于任何原因排除特定问题的一种方法。因此,如果确定PLZ案例ID没有名称是可以的,那么它将被排除在问题表上

Issue 1      Issue 2     Issue 3
DEF123                   DEF123

PLZ不会出现在上面的示例中,因为它在排除表中

在尝试此代码之前,请先复制数据:

你需要使它适应你的需要。我不太明白这一排什么时候是空的。无论如何,使用范围可能更快、更容易调试

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

你的代码有效吗?如果是这样的话,你会在代码审查上有更好的运气,是的。但我知道有更好的办法。此外,我不知道如何让代码在所有列中运行,而不是对所有10+列重复for/next循环,该循环将随着时间的推移而不断增加。然后,您应该使用代码审阅。而不是使用嵌套循环进行工作表行比较,您可以只使用筛选器并删除单元格内容。更好的是,将数据从排除表捕获到和数组中,然后对问题表执行筛选。说了这么多,这应该放在代码审查网站上。我已经根据每个人的建议在那里发布了它,但是响应时间要慢得多。如果有人有任何输入,那就太棒了。我尝试过使用它,但它使我的excel实例崩溃。是因为两张纸之间的所有列都有循环吗?不过还是设法使用了某些部分:它只在排除表中的J到L列上循环,在问题表中的A到C列上循环。它不应该坠毁。试着用F8一步一步地运行代码,看看你是否能识别出它在哪一行崩溃。