根据第三列值的值比较两列

我想要做的是创build一个macros来查看列（AF），并根据该值，比较列（BI），（BJ）和/或（BK）在一起，如果它的假，突出显示比较的单元格黄色。 我知道这有点难以遵循，但这个例子应该有助于澄清：

我的表格有以下几列：

Column AF Column BI Column BJ Column BK PRODUCT Height Length Width 

我需要一个macros来查看产品types，并比较该产品的尺寸如下：

  - If product = A, then Length = Width, if not then highlight Length and Width Cells - If product = B then Length > Width, if not then highlight Length and Width Cells - If product = C then Width > Height < Length, if not highlight Length, Width, and Height cells - If product - D then Width = Length < Height, if not highlight Width, Length, and/or Height 

我的数据从第3行开始，到第5002行结束。

我试图研究这一点，只能find比较两个单元格然后写第三列的解决scheme。 我可以结合一个IF公式和条件格式来实现这一点，但我不想让这个运行所有的时间，因为工作表将被sorting和颜色编码。 我打算把这个macros放到命令button中。

Answer 1

build议合并Statements ，如Select Case ， If...Then...Else ，与Operators And ， Or 。 请参阅以下页面：

https://msdn.microsoft.com/en-us/library/office/gg251599.aspx

https://msdn.microsoft.com/en-us/library/office/gg278665.aspx

https://msdn.microsoft.com/EN-US/library/office/gg251356.aspx

之后，你应该能够写下类似这样的东西:( 下面的代码只是一个示例，它不会工作）

 Select Case Product Case A If Length <> Width Then Rem Highlight Length And Width Cells End If Case B If Length <= Width Then Rem Insert here the code to highlight Length And Width Cells End If Case C If Width <= Height And Height >= Length Then Rem Insert here the code to highlight Length, Width, and Height cells End If Case D If Width <> Length And Length >= Height Then Rem Insert here the code to highlight Width, Length, and/or Height End If End Sub 

如果您不知道如何突出宽度，长度和高度单元格; 我build议在录制macros时手动完成，这应该是一个很好的起点。

Answer 2

我build议使用对象，为Data范围定义variables，validation每一行，validation字段的位置等。

 Sub Highlight_Cells_based_Comparison() Dim rData As Range Dim rRow As Range Dim rCllsUnion As Range Rem Set variables to hold Fields position within the DATA range Dim bPosProd As Byte, bPosHght As Byte, bPosLeng As Byte, bPosWdth As Byte Rem Set variables to hold Fields values Rem (data type Variant as don't know type of values these fields are holding, change as appropriated) Rem see https://msdn.microsoft.com/en-us/library/office/gg251528.aspx) Dim sProd As String, vHght As Variant, vLeng As Variant, vWdth As Variant Dim lRow As Long Rem Set Range (assuming it goes from column C to BK - change as needed) Rem Not starting from column A on porpuse Set rData = ActiveSheet.Range("C3:BK5002") Rem Get Fields position from Header row Rem Suggest to use this method instead of hard coding columns On Error Resume Next With rData bPosProd = WorksheetFunction.Match("PRODUCT", .Rows(1), 0) bPosHght = WorksheetFunction.Match("Height", .Rows(1), 0) bPosLeng = WorksheetFunction.Match("Length", .Rows(1), 0) bPosWdth = WorksheetFunction.Match("Width", .Rows(1), 0) End With If Err.Number <> 0 Then Exit Sub On Error GoTo 0 Rem Loop thru each row excluding header For lRow = 2 To rData.Rows.Count Set rRow = rData.Rows(lRow) With rRow Rem Get Row Field values sProd = .Cells(bPosProd).Value2 vHght = .Cells(bPosHght).Value2 vLeng = .Cells(bPosLeng).Value2 vWdth = .Cells(bPosWdth).Value2 Select Case sProd Case A 'Change value of A as required Rem If product = A, then Length = Width, if not then highlight Length and Width Cells Rem If Length <> Width Then Highlight Length And Width 'Cells If vLeng <> vWdth Then Set rCllsUnion = Union(.Cells(bPosLeng), .Cells(bPosWdth)) Rem Suggest to use a subroutine for this piece as it's a repetitive task Rem see https://msdn.microsoft.com/en-us/library/office/gg251648.aspx GoSub CllsUnion_Highlight End If Case B Rem repeat as in Case A with required changes Case C '... Case D '... End Select: End With: Next Exit Sub Rem Subroutine to highlight cells CllsUnion_Highlight: With rCllsUnion.Interior .Color = 65535 .TintAndShade = 0 .Pattern = xlSolid .PatternColorIndex = xlAutomatic .PatternTintAndShade = 0 End With Return End Sub