根据另一张表中的列表的内容，Excel清除单元格 [英] Excel clear cells based on contents of a list in another sheet

问题描述

我有一个excel Sheet1从一千行和20列从A1到T1。该范围内的每个单元格中都有一些数据，通常是一个或两个单词。
在Sheet2，A1列中，我有一个1000个数据的数据列表。

我正在从事VBA脚本从Sheet1中的Sheet2列表中找到单词，并清除找到的单元格的值。

我现在有一个仅在Sheet1的A1列上工作的VBA脚本，它只删除行。这是脚本：

  Sub DeleteEmails（）
 Dim rList As Range 
 Dim rCrit As Range 
 
使用工作表（Sheet1）
 .Range（A1）。插入shift：= xlDown：.Range（A1）。Value =Temp标题
设置rList = .Range（A1，.Cells（Rows.Count，1）.End（xlUp））
结束与
与工作表（Sheet2）
 .Range（A1 ）.Insert shift：= xlDown：.Range（A1）。Value =Temp Header
设置rCrit = .Range（A1，.Cells（Rows.Count，1）.End（xlUp ）
结束
 
 rList.AdvancedFilter操作：= xlFilterInPlace，CriteriaRange：= rCrit，Unique：= False 
 rList.Offset（1）.SpecialCells（xlCellTypeVisible）.Delete shift：= xlUp 
工作表（Sheet1）ShowAllData 
 
 rList（1）.Delete shift：= xlUp：rCrit（1）.Delete shift：= xlUp 
 
设置rList = Nothing：设置rCrit = Nothing 
 End Sub 
  

我？我需要清除的值，而不是删除行，这应该适用于Sheet1的所有列，而不仅仅是A1。

解决方案

是通过最小化片材（通过范围/单元格的迭代）和代码之间的流量来使用数组的另一种方法。该代码不使用任何清除内容。只需点击一下按钮，将整个范围纳入阵列，清理并输入所需的内容。

• 已编辑为每个OP的请求：添加评论并更改他所需的表格的代码。

代码：

  Option Explicit 
 
 Sub matchAndClear（）
 Dim ws As Worksheet 
 Dim arrKeys As Variant，arrData As Variant 
 Dim i As Integer，j As Integer，k As Integer 
 
' - 这里我们从Sheet 1中获取键列到1D数组
 arrKeys = WorksheetFunction.Transpose（Sheets（1 ）.Range（A2：A11）。Value）
' - 这里我们将要从清单2中的清理范围转换为2D数组
 arrData = WorksheetFunction.Transpose（Sheets（2 ）.Range（C2：D6）。值）
 
' - 这里我们遍历每个按键的数组搜索
' - 要清理array 
对于i = LBound（arrKeys）到UBound（arrKeys）
对于j = LBound（arrData， 2）到UBound（arrData，2）
' - 当有匹配时，我们清除该元素
如果UCase（Trim（arrData（1，j）））= UCase（Trim（arrKeys（i ）））然后
 arrData（1，j）=
 End If 
' - 当有匹配时，我们清除该元素
如果UCase（Trim（arrData 2，j）））= UCase（Trim（arrKeys（i）））然后
 arrData（2，j）=
 End If 
 Next j 
 Next i 
 
' - 用表2中的新数据替换旧数据:) 
 Sheets（2）.Range（C2）。Offset（0，0）.Resize（UBound（arrData ，2），_ 
 UBound（arrData））= Application.Transpose（arrData）
 
 End Sub 
  

• 请不要在这里你真正需要设置的范围是：

  
  
  1. 密钥范围
  
  
  2. 待清理范围
  
  

输出：（用于替代目的是使用相同的工作表，但是您可以根据需要更改工作表名称。

根据OP的运行OP文件请求进行编辑：

它没有清理所有列的原因是，在上面的示例中只清理两列，因为您有16列。因此，您需要为循环添加另一个来遍历它。没有太多的性能下降，但有一点;）以下是运行您发送的工作表后的屏幕截图。除此之外，没有任何改变。

代码：

  - 在这里我们遍历每个按键数组中的每个键在
' - 待清理数组
 For i = LBound（arrKeys）到UBound（arrKeys）
 For j = LBound（arrData，2）到UBound（arrData，2）
对于k = LBound（arrData）到UBound（arrData）
' - 当有匹配时，我们清除该元素
如果UCase（Trim（arrData（k，j）））= UCase（Trim（arrKeys（i）））然后
 arrData（k，j）=
 End If 
 Next k 
下一个j 
下一个i 
  

I have an excel Sheet1 of a thousand of rows and 20 columns from A1 to T1. Each cell in that range has some data in it, usually one or two words. In Sheet2, A1 column I have a list of data of 1000 values.

I am working on VBA script to find words from Sheet2 list in Sheet1 and clear the values of the cells of the found ones.

I now have a VBA script that works only on A1 column of Sheet1 and it deletes the rows only. Here's the script:

Sub DeleteEmails() 
Dim rList As Range 
Dim rCrit As Range 

With Worksheets("Sheet1") 
    .Range("A1").Insert shift:=xlDown: .Range("A1").Value = "Temp Header" 
    Set rList = .Range("A1", .Cells(Rows.Count, 1).End(xlUp)) 
End With 
With Worksheets("Sheet2") 
    .Range("A1").Insert shift:=xlDown: .Range("A1").Value = "Temp Header" 
    Set rCrit = .Range("A1", .Cells(Rows.Count, 1).End(xlUp)) 
End With 

rList.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=rCrit, Unique:=False 
rList.Offset(1).SpecialCells(xlCellTypeVisible).Delete shift:=xlUp 
Worksheets("Sheet1").ShowAllData 

rList(1).Delete shift:=xlUp: rCrit(1).Delete shift:=xlUp 

Set rList = Nothing: Set rCrit = Nothing 
End Sub 

Could anyone help me? I need the values cleared, not rows deleted, and this should work on all columns of Sheet1, not just A1.

解决方案

Here is another method using an array by minimizing the traffic between sheet (iteration via range/cells) and code. This code doesn't use any clear contents. Simply take the whole range into an array, clean it up and input what you need :) with a click of a button.

• edited as per OP's request: adding comments and changing the code for his desired sheets.

Code:

Option Explicit

Sub matchAndClear()
    Dim ws As Worksheet
    Dim arrKeys As Variant, arrData As Variant
    Dim i As Integer, j As Integer, k As Integer

    '-- here we take keys column from Sheet 1 into a 1D array
    arrKeys = WorksheetFunction.Transpose(Sheets(1).Range("A2:A11").Value)
    '-- here we take to be cleaned-up-range from Sheet 2 into a 2D array
    arrData = WorksheetFunction.Transpose(Sheets(2).Range("C2:D6").Value)

    '-- here we iterate through each key in keys array searching it in 
    '-- to-be-cleaned-up array
    For i = LBound(arrKeys) To UBound(arrKeys)
        For j = LBound(arrData, 2) To UBound(arrData, 2)
                '-- when there's a match we clear up that element
                If UCase(Trim(arrData(1, j))) = UCase(Trim(arrKeys(i))) Then
                    arrData(1, j) = " "
                End If
                '-- when there's a match we clear up that element
                If UCase(Trim(arrData(2, j))) = UCase(Trim(arrKeys(i))) Then
                    arrData(2, j) = " "
                End If
        Next j
    Next i

    '-- replace old data with new data in the sheet 2 :)
    Sheets(2).Range("C2").Offset(0, 0).Resize(UBound(arrData, 2), _
    UBound(arrData)) = Application.Transpose(arrData)

End Sub

• Please not that you what you really need to set here are the ranges:

  1. Keys range
  2. To-Be-Cleaned up range

Output: (for displaying purpose I am using the same sheet, but you can change the sheet names as you desire.

Edit based on OP's request for running OP's file:

The reason that it didn't clean all your columns is that in the above sample is only cleaning two columns where as you have 16 columns. So you need to add another for loop to iterate through it. Not much performance down, but a little ;) Following is a screenshot after running your the sheet you sent. There is nothing to change except that.

Code:

'-- here we iterate through each key in keys array searching it in
    '-- to-be-cleaned-up array
    For i = LBound(arrKeys) To UBound(arrKeys)
        For j = LBound(arrData, 2) To UBound(arrData, 2)
            For k = LBound(arrData) To UBound(arrData)
                '-- when there's a match we clear up that element
                If UCase(Trim(arrData(k, j))) = UCase(Trim(arrKeys(i))) Then
                    arrData(k, j) = " "
                End If
            Next k
        Next j
    Next i

这篇关于根据另一张表中的列表的内容，Excel清除单元格的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！