vba 基于来自同一工作簿中另一个工作表的数据的工作表中的颜色单元格
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/11387116/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
Color Cells in a Worksheet Based on Data From Another Worksheet in Same Workbook
提问by Mike
I have the following worksheet called Data:
我有以下名为Data 的工作表：
In the same workbook I have another worksheet called Employee Database.
在同一个工作簿中，我有另一个名为Employee Database 的工作表。
In Excel, how can I color the "Employee E-mail Address" and the corresponding "Company" and "Company URL" cells red from the Dataworksheet if the "Employee E-mail Address" is not in the Employee Database?
在 Excel 中，如果“员工电子邮件地址”不在员工数据库中，如何将数据工作表中的“员工电子邮件地址”以及相应的“公司”和“公司 URL”单元格着色为红色？
In otherwords, I am trying to make the Employee Databaseworksheet look like this:
换句话说，我试图让员工数据库工作表看起来像这样：
I've just given an example and in reality I have over 10,000 cells worth of data to do this to. I started doing this manually and realized it will take me forever.
我刚刚举了一个例子，实际上我有超过 10,000 个单元格的数据来做这个。我开始手动执行此操作，并意识到这将花费我永远。
I'd love to know if there is a macro that can do this in Excel?
我想知道是否有可以在 Excel 中执行此操作的宏？
Help would be so much appreciated! I have the example workbook of the screenshots above available for download here: http://www.mediafire.com/?dttztp66dvjkzn8
非常感谢您的帮助！我有上面截图的示例工作簿，可以在这里下载：http: //www.mediafire.com/?dttztp66dvjkzn8
回答by Siddharth Rout
Is this what you are trying? This will create a new sheet "Desired Result" with the output. Paste this in a module.
这是你正在尝试的吗？这将创建一个带有输出的新工作表“所需结果”。将其粘贴到模块中。
Option Explicit
Sub Sample()
Dim wsData As Worksheet, wsDB As Worksheet, wsO As Worksheet
Dim lRow As Long, i As Long
Dim clrRng As Range
Set wsData = Sheets("Data")
Set wsDB = Sheets("Employee Database")
Set wsO = Sheets.Add
On Error Resume Next
Application.DisplayAlerts = False
Sheets("Desired Result").Delete
Application.DisplayAlerts = True
On Error GoTo 0
With wsO
.Name = "Desired Result"
wsData.Cells.Copy .Cells
lRow = .Range("B" & .Rows.Count).End(xlUp).Row
For i = 2 To lRow
If .Range("A" & i).Value = "" Then .Range("A" & i).Value = .Range("A" & i - 1).Value
Next i
For i = 1 To lRow
If Application.WorksheetFunction.CountIf(wsDB.Columns(3), .Range("A" & i).Value) = 0 Then
If clrRng Is Nothing Then
Set clrRng = .Rows(i)
Else
Set clrRng = Union(clrRng, .Rows(i))
End If
End If
Next i
If Not clrRng Is Nothing Then clrRng.Interior.ColorIndex = 3
For i = lRow To 2 Step -1
If .Range("A" & i).Value = .Range("A" & i - 1).Value Then .Range("A" & i).ClearContents
Next i
End With
End Sub
回答by JimmyPena
You can do this without VBA, but it will require a slight change to the data on your Datasheet.
您可以在没有 VBA 的情况下执行此操作，但需要对工作Data表上的数据稍作更改。
I don't recommend the "Pivot Table" or "Subtotal"-style of data storage in Excel, where you enter a primary key in one column only oncethen fill down associated data next to it until the next primary key.
我不建议在 Excel 中使用“数据透视表”或“小计”样式的数据存储，在这种情况下，您只在一列中输入主键一次，然后填充旁边的关联数据，直到下一个主键。
Like merged cells, this will only lead to problems later when you want to re-organize your data.
与合并的单元格一样，这只会在以后想要重新组织数据时导致问题。
Here's what I did:
这是我所做的：
Fill in missing email addresses on Data sheet
填写数据表上缺少的电子邮件地址
Highlight cells A2all the way down column Ato the end of the data in column B. So if you had company names in cells B2:B100, but only had emails from A2:A98, you should highlight A2:A100. This is because we are filling in the email address in each row of available data.
突出显示单元格A2一直向下A到列B 中数据的末尾。因此，如果您在单元格中有公司名称B2:B100，但只有来自的电子邮件A2:A98，则应突出显示A2:A100。这是因为我们正在每行可用数据中填写电子邮件地址。
Go to Editing» Find & Select» Go To Special, select Blanksand click OK.
转到编辑»查找和选择»转到特殊，选择Blanks并单击OK。
Now with blanks selected, type =↑(up arrow) , then press Ctrl+Enter. The blank cells in column A will fill in with the missing email addresses. Highlight column A, copy and paste values.
现在选择空白，输入=↑(向上箭头) ，然后按Ctrl+ Enter。A 列中的空白单元格将填充缺少的电子邮件地址。突出显示 A 列，复制并粘贴值。
Create Dynamic Named Range for Emails
为电子邮件创建动态命名范围
On the Employee Databasesheet, create a named range called "Emails" with the following formula in the "Refers to" box:
在工作Employee Database表上，使用以下公式在“引用”框中创建一个名为“电子邮件”的命名范围：
=OFFSET('Employee Database'!$C$1,1,0,COUNTA('Employee Database'!$C:$C)-1,1)
=OFFSET('Employee Database'!$C$1,1,0,COUNTA('Employee Database'!$C:$C)-1,1)
Add Conditional Formatting
添加条件格式
On the Datasheet, highlight A2:C whatever(ex: A2:C20000), then go to Home» Styles» Conditional Formattingand use the following formula:
在工作Data表上，突出显示A2:C whatever（例如：）A2:C20000，然后转到主页»样式»条件格式并使用以下公式：
=ISNA(MATCH($A2,Emails,0))
=ISNA(MATCH($A2,Emails,0))
Select the color scheme you want and click OK. Here's how it looks on my computer with some sample data:
选择所需的配色方案并单击OK。以下是它在我的计算机上的显示和一些示例数据：
There are a few minor constraints:
有一些小的限制：
- You cannot leave column A blank on the
Datasheet any more. - You cannot have blank rows on the
Employee Databasesheet in between rows of data. This is due to the way the dynamic range works.
- 您不能再将工作
Data表上的 A 列留空。 - 工作
Employee Database表上的数据行之间不能有空白行。这是由于动态范围的工作方式造成的。
Benefits
好处
The benefits of this approach are, IMO, huge.
这种方法的好处是，IMO，巨大的。
- You can add or remove rows from the Employee Database sheet, and the highlighting will automatically adjust. Ex: if I add [email protected] and remove [email protected], the formatting on the
Datasheet updates immediately.
- 您可以在员工数据库表中添加或删除行，突出显示将自动调整。例如：如果我添加 [email protected] 并删除 [email protected]，工作
Data表上的格式会立即更新。
- You don't have to alter your existing worksheet structure (other than filling in the missing data and adding a range name). No need for additional worksheets.
- Your workbook can stay VBA-free (if it didn't have any already).
- 您不必更改现有的工作表结构（除了填写缺失的数据并添加范围名称）。无需额外的工作表。
- 您的工作簿可以保持无 VBA（如果它还没有）。
