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

问题描述

我有一个从 A1 到 T1 的一千行和 20 列的 Excel Sheet1.该范围内的每个单元格中都有一些数据，通常是一两个字.在 Sheet2 的 A1 列中，我有一个包含 1000 个值的数据列表.

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.

我正在使用 VBA 脚本从 Sheet1 中的 Sheet2 列表中查找单词并清除找到的单元格的值.

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.

我现在有一个 VBA 脚本，它只适用于 Sheet1 的 A1 列，并且它只删除行.这是脚本:

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 

有人可以帮我吗?我需要清除值，而不是删除行，这应该适用于 Sheet1 的所有列，而不仅仅是 A1.

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.

• 根据 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

    '-- 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. 键范围
    2. 待清理范围

  输出:(为了显示目的，我使用同一张工作表，但您可以根据需要更改工作表名称.

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

  根据 OP 对运行 OP 文件的请求进行

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

  它没有清洗所有列的原因是在上面的示例中只清洗了两列，而您有 16 列.所以你需要添加另一个 for 循环来遍历它.没有太大的性能下降，但有点 ;) 以下是运行您发送的工作表后的屏幕截图.除此之外没有什么可以改变的.

  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.

  代码:

  '-- 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屋！