根据另一个工作表列表内容的Excel单元格清晰 [英] Excel clear cells based on contents of a list in another sheet
问题描述
我行的千一个Excel工作表Sheet1，并从A1 20列T1。在这个范围内的每个单元都有一些数据在里面，通常是一个或两个词。
在Sheet2中，A1专栏中，我有1000个值的数据列表。
我的工作VBA脚本来找到在Sheet1 Sheet2的名单的话，清除那些发现的单元格的值。
我现在有一个VBA脚本，仅适用于工作表Sheet1的A1列，只删除行。这里的脚本：
子DeleteEmails（）
昏暗的rlist由于范围
昏暗rCrit由于范围随着工作表（工作表Sheet1）
。.Range（A1）将转变：= xlDown：.Range（A1）值=临时头
设置RLIST = .Range（A1，.Cells（Rows.Count，1）.END（xlUp））
结束与
随着工作表（Sheet2的）
。.Range（A1）将转变：= xlDown：.Range（A1）值=临时头
设置rCrit = .Range（A1，.Cells（Rows.Count，1）.END（xlUp））
结束与rList.AdvancedFilter操作：= xlFilterInPlace，CriteriaRange：= rCrit，独特之处：=假
rList.Offset（1）.SpecialCells（xlCellTypeVisible）.Delete转变：= xlUp
工作表（工作表Sheet1）。ShowAllDataRLIST（1）.Delete转变：= xlUp：rCrit（1）.Delete转变：= xlUp设置RLIST =什么：设置rCrit =什么
结束小组
谁能帮助我？我需要的值清零，没有删除的行，这应该在Sheet1中的所有列，而不仅仅是A1。
工作下面是通过减少表（通过迭代范围/细胞）和code之间的通信使用数组的另一种方法。这code不使用任何清除内容。简单地采取全量程到一个数组，清理和输入你所需要的:)一个按钮，点击。
- 编辑为每OP的要求：添加注释和更改code，他希望张
code：
显式的选项子matchAndClear（）
昏暗的WS作为工作表
昏暗arrKeys为Variant，arrData为Variant
昏暗我作为整数，J为整数，K为整数 - 下面我们就从钥匙1片成列一维数组
arrKeys = WorksheetFunction.Transpose（表（1）.Range（A2：A11）值）
- 在这里，我们要采取从表2清理后的范围为一个二维数组
arrData = WorksheetFunction.Transpose（表（2）.Range（C2：D6）值） - 在这里，我们通过按键阵列中的每个迭代的关键在其搜索
' - 向被扫除式阵列
对于i = LBOUND（arrKeys）为UBound函数（arrKeys）
对于j = LBOUND（arrData，2）向UBound函数（arrData，2）
- 当有一个比赛，我们清理该元素
如果用Ucase（修剪（arrData（1，J）））=用Ucase（修剪（arrKeys（I）））然后
arrData（1，J）=
万一
- 当有一个比赛，我们清理该元素
如果用Ucase（修剪（arrData（2，J）））=用Ucase（修剪（arrKeys（I）））然后
arrData（2，j）的=
万一
下面j
接下来，我 - 在表2用新数据替换旧数据:)
片（2）.Range（C2）。偏移（0,0）.Resize（UBound函数（arrData，2），_
UBound函数（arrData））= Application.Transpose（arrData）结束小组
-
请不在于你究竟需要在此处设置有范围：
- 键的范围
- 要被清扫了范围
输出：（用于显示目的，我使用同一张纸上，但你希望你可以改变工作表名称
根据OP的要求运行OP的文件编辑：
这是它没有清理你的所有列的原因是，上述样品中仅清洗的地方，你有16列两列。所以，你需要添加另一个为循环来遍历它。没有太多的性能下降，但一点;）以下是你运行你送的表后的截图。没有什么，只是改变。
code：
- 在这里，我们通过按键阵列中的每个迭代的关键在其搜索
' - 向被扫除式阵列
对于i = LBOUND（arrKeys）为UBound函数（arrKeys）
对于j = LBOUND（arrData，2）向UBound函数（arrData，2）
对于k = LBOUND（arrData）向UBound函数（arrData）
- 当有一个比赛，我们清理该元素
如果用Ucase（修剪（arrData（K，J）））=用Ucase（修剪（arrKeys（I）））然后
arrData（K，J）=
万一
下面k
下面j
接下来，我
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:
- Keys range
- 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屋！
