Question

我有2张纸设置：排除和问题

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

排除项将使用要从“问题”表中排除（并删除）的CASE ID填充。

我的问题是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将不会显示，因为它在“ EXCLUSIONS”表中。

Answer 1

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

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

1 个答案: