滿足條件時著色行

我對 VBA 完全陌生，我想要做的是在滿足條件并且在不同作業表的另一列中找到產品包裝的有效值時為單元格著色。

我一直在嘗試寫一些可以做到這一點的東西，但它不起作用。if 陳述句有問題，但我找不到在哪里。

Sub validation()

Dim lastRow_s As Long
Dim lastRow_m As Long

lastRow_s = Sheets("product").Cells(Rows.Count, "D").End(xlUp).Row
lastRow_m = Sheets("product").Cells(Rows.Count, "H").End(xlUp).Row

    For i = 2 To lastRow_s
        For j = 2 To lastRow_m
            If Sheets("product").Cells(i,"D").Value = 
                Sheets("valid_package").Cells(j,"A").Value And
                Sheets("product").Cells(i, "H").Value =
                Sheets("valid_package").Cells(j,"B").Value Then
                Sheets("product").Cells(i, "H").Value = vbGreen
            End If
        Next j
    Next i


End Sub

我在這里找不到我做錯了什么。

所以我想要做的是迭代兩列以確保 D 列中的產品在產品表的 H 列中具有有效的包。在 valid_package 表中，有一列適用于該產品的產品和包裝，因此 valid_package 如下所示：

如果只取兩列，產品表是這樣的：

我想要的是在 H 列中突出顯示片材產品的正確包裝或在 H 列中突出顯示片材產品的錯誤包裝，無論顏色是什么都沒有關系。

現在我得到的是。預期：“行號或標簽或陳述句或陳述句結束。

uj5u.com熱心網友回復：

顏色條件匹配單元格

Option Explicit

Sub TestAll()
    ValidationQuickFix
    ValidationReadable
    ValidationEfficient
' Result on 1000 matches in 10000 rows of destination 
' with only 10 rows of unique source values:
' Quick Fix: 6,1875
' Readable:  2,21484375
' Efficient: 0,87890625
End Sub

Sub ValidationQuickFix()
    Dim t As Double: t = Timer
    
    ThisWorkbook.Activate
    
    Dim lastRow_s As Long
    lastRow_s = Worksheets("valid_package").Cells(Rows.Count, "A").End(xlUp).Row
    Dim lastRow_d As Long
    lastRow_d = Worksheets("product").Cells(Rows.Count, "D").End(xlUp).Row

    Dim i As Long, j As Long

    For i = 2 To lastRow_d
        For j = 2 To lastRow_s
            If Worksheets("product").Cells(i, "D").Value = _
                    Worksheets("valid_package").Cells(j, "A").Value Then
                If Worksheets("product").Cells(i, "H").Value = _
                        Worksheets("valid_package").Cells(j, "B").Value Then
                    Worksheets("product").Cells(i, "H").Interior.Color = vbGreen
                Else
                    Worksheets("product").Cells(i, "H").Interior.Color = xlNone
                End If
            End If
        Next j
    Next i

    Debug.Print "Quick Fix: " & Timer - t
End Sub

Sub ValidationReadable()
    Dim t As Double: t = Timer
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("valid_package")
    Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
    
    Dim dws As Worksheet: Set dws = wb.Worksheets("product")
    Dim dlRow As Long: dlRow = dws.Cells(dws.Rows.Count, "D").End(xlUp).Row

    Dim i As Long, j As Long
    
    For i = 2 To dlRow
        For j = 2 To slRow
            If dws.Cells(i, "D").Value = sws.Cells(j, "A").Value Then
                If dws.Cells(i, "H").Value = sws.Cells(j, "B").Value Then
                    dws.Cells(i, "H").Interior.Color = vbGreen
                Else
                    dws.Cells(i, "H").Interior.Color = xlNone
                End If
            End If
        Next j
    Next i

    Debug.Print "Readable:  " & Timer - t
End Sub

Sub ValidationEfficient()
    Dim t As Double: t = Timer
    
    Dim wb As Workbook: Set wb = ThisWorkbook
    
    Dim sws As Worksheet: Set sws = wb.Worksheets("valid_package")
    Dim slRow As Long: slRow = sws.Cells(sws.Rows.Count, "A").End(xlUp).Row
    Dim srg1 As Range: Set srg1 = sws.Range("A2:A" & slRow)
    Dim srg2 As Range: Set srg2 = sws.Range("B2:B" & slRow)
    
    Dim dws As Worksheet: Set dws = wb.Worksheets("product")
    Dim dlRow As Long: dlRow = dws.Cells(dws.Rows.Count, "D").End(xlUp).Row
    Dim drg1 As Range: Set drg1 = dws.Range("D2:D" & dlRow)
    Dim drg2 As Range: Set drg2 = dws.Range("H2:H" & dlRow)

    Dim ddrg As Range
    Dim dCell As Range
    Dim sIndex As Variant
    Dim dr As Long
    
    For dr = 1 To drg1.Rows.Count
        sIndex = Application.Match(drg1.Cells(dr).Value, srg1, 0)
        If IsNumeric(sIndex) Then
            If drg2.Cells(dr).Value = srg2.Cells(sIndex).Value Then
                If ddrg Is Nothing Then
                    Set ddrg = drg2.Cells(dr)
                Else
                    Set ddrg = Union(ddrg, drg2.Cells(dr))
                End If
            End If
        End If
    Next dr

    If Not ddrg Is Nothing Then
        drg2.Interior.Color = xlNone
        ddrg.Interior.Color = vbGreen
    End If

    Debug.Print "Efficient: " & Timer - t
End Sub

uj5u.com熱心網友回復：

請測驗下一個代碼。它應該很快，使用Find，將要著色的Union范圍放在一個范圍內并在代碼末尾著色。我希望我正確理解你想要什么，主要是你擁有什么......

Sub validation()
Dim shP As Worksheet, shVP As Worksheet, rngColor As Range, rngA As Range, rngB As Range
Dim lastRow_P As Long, lastRow_VP As Long, cellMatch As Range, i As Long

Set shP = Sheets("product")
Set shVP = Sheets("valid_package")
lastRow_P = shP.cells(rows.Count, "D").End(xlUp).row
lastRow_VP = shVP.cells(rows.Count, "A").End(xlUp).row


Set rngA = shVP.Range("A2:A" & lastRow_VP)
For i = 2 To lastRow_P
    Set cellMatch = rngA.Find(what:=shP.cells(i, "D").Value, LookIn:=xlValues, Lookat:=xlWhole)
    If Not cellMatch Is Nothing Then
        If cellMatch.Offset(0, 1).Value = shP.cells(i, "H").Value Then
            If rngColor Is Nothing Then
                Set rngColor = shP.cells(i, "H")
            Else
                Set rngColor = Union(rngColor, shP.cells(i, "H"))
            End If
        End If
    End If
Next i

If Not rngColor Is Nothing Then rngColor.Interior.color = vbGreen
End Sub

標籤：擅长 vba

上一篇：VBA回圈遍歷陣列

下一篇：VBA如何在行中添加下一個日期