VBA -如果在sheet2中找到sheet1中的值，则从sheet2中删除数据
VBA -如果在sheet2中找到sheet1中的值，则从sheet2中删除数据
提问于 2019-04-15 23:41:02
我有两个工作表设置:排除和问题
Issues有一个案例ID列表和列，其中列出了"Issue“
Exclusions将填充要从问题单中排除(和删除)的案例ID。
我的问题有两层：
- 我当前的代码是否能正确处理此问题？有什么方法可以改进这一点吗？
- 有没有一种方法可以让代码动态地循环所有列？或者，为"Issues“工作表上的每一列复制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数据格式：
"Issues“页
CASE ID Issue 1 Issue 2 Issue 3
ABC123 No address No Name No Number"Exclusions“表
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 DEF123PLZ不会出现在上面的例子中，因为它在"EXCLUSIONS“表中。
回答 1
Stack Overflow用户
回答已采纳
发布于 2019-04-16 03:58:22
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页面原文内容由Stack Overflow提供。腾讯云小微IT领域专用引擎提供翻译支持
原文链接：
https://stackoverflow.com/questions/55692766
复制相关文章
相似问题