对一列单元格中具有特定值的所有行运行 VBA

Question

首先 - 我不是 VBA 专家，可以称自己为中级 excel 用户。我有一个广泛的 VBA 宏，我试图仅将其应用于数百行中的大约 55 行。

然后，我想对另一组在同一列中具有不同值的行运行相同的宏。

我曾尝试使用单独的宏来暴力破解它，但没有成功。下面的代码适用于整个工作表中的所有行，但我想针对 ie 运行它。行 2:54。再次反对 55:107。再说一遍……

到目前为止，这是我的代码：

Sub ChkInvAvail()


'Color any cell GREEN when the number of parts on hand is equal or greater to the corresponding re-order value
'Color the cell RED when the number of parts on hand is less than the corresponding re-order value
'Color cell A1 Green if all inventory levels are satisfactory. Color A1 Red if not
Dim OnHandCol As Long
Dim ReOrdPntCol As Long
Dim OnHand, ReOrdPnt, rngOnHand, rngReOrdPnt, AllRedGreenCells, OxmoorGreenCell As Range
Dim ShoreViewGreenCell, SilasGreenCell, StLouisGreenCell, PhoenixGreenCell, WECGreenCell As Range
Dim LastRowA, LastRowB, lastRow, DataStartRow As Long
Dim r, i, j As Long
Dim i As Long
Dim j As Long

    '2 Lines Below Column Address Can Be Changed if Needed
    Set rngOnHand = ActiveSheet.Range("I:I")
    Set rngReOrdPnt = ActiveSheet.Range("M:M")
    '1 Line Below Single Cell Address in Col C Can Be Changed if Needed
    Set AllRedGreenCells = ActiveSheet.Range("A1")
    Set OxmoorGreenCells = ActiveSheet.Range("E3")
    Set ShoreViewGreenCells = ActiveSheet.Range("E4")
    Set CharlotteGreenCells = ActiveSheet.Range("E5")
    Set StLouisGreenCells = ActiveSheet.Range("E6")
    Set PhoenixGreenCells = ActiveSheet.Range("E7")
    Set WECGreenCells = ActiveSheet.Range("E8")

    '1 Line Below Row the actual data starts changes
    DataStartRow = 2

    LastRowA = MaxRowInXlRange(ActiveSheet, rngOnHand.Address)
    LastRowB = MaxRowInXlRange(ActiveSheet, rngReOrdPnt.Address)
    lastRow = Application.Max(LastRowA, LastRowB)

    OnHandCol = rngOnHand.Column
    ReOrdPntCol = rngReOrdPnt.Column

    i = 0
    j = 0

    For r = DataStartRow To lastRow

        Set OnHand = ActiveSheet.Range(Cells(r, OnHandCol), Cells(r, OnHandCol))
        Set ReOrdPnt = ActiveSheet.Range(Cells(r, ReOrdPntCol), Cells(r, ReOrdPntCol))

        If OnHand.Value >= ReOrdPnt.Value Then
            OnHand.Interior.Color = RGB(0, 255, 0) 'RGB Code for GREEN
            'ReOrdPnt.Interior.Color = RGB(0, 255, 0) 'Remove Comment if you want B to Be GREEN too
        Else
            If OnHand.Value >= ReOrdPnt.Value * 0.5 And OnHand.Value > 0 Then
                ReOrdPnt.Interior.Color = RGB(240, 240, 50) 'RGB Code for Yellow
                'ReOrdPnt.Interior.Color = RGB(0, 255, 0) 'Remove Comment if you want B to Be GREEN too
                j = j + 1

            Else
                ReOrdPnt.Interior.Color = RGB(255, 0, 0) ''RGB Code for RED
                'OnHand.Interior.Color = RGB(255, 0, 0) 'Remove Comment if you want A to Be RED too
                i = i + 1
            End If
        End If
    Next

    If i > 0 Then
        AllRedGreenCells.Interior.Color = RGB(255, 0, 0)
    Else
        If j > 0 Then
            AllRedGreenCells.Interior.Color = RGB(240, 240, 50)
            Else
            AllRedGreenCells.Interior.Color = RGB(0, 255, 0)
        End If
    End If

End Sub

Function MaxRowInXlRange(xlWsh As Excel.Worksheet, DataRange As String) As Long
Dim MaxRow As Long
Dim ColRow As Long

    'Begin Find Last Row
    MaxRow = 1
    ColRow = 1
    For Each col In xlWsh.Range(DataRange).Columns
        ColRow = xlWsh.Cells(xlWsh.Rows.Count, col.Column).End(xlUp).Row
        If ColRow > MaxRow Then
            MaxRow = ColRow
        End If
    Next
    MaxRowInXlRange = MaxRow
    'End Find Last Row

End Function

Function MaxColInXlRange(xlWsh As Excel.Worksheet, DataRange As String) As Long
Dim MaxCol As Long
Dim ColRow As Long

    'Begin Find Last Row
    MaxCol = 0
    ColRow = 1
    For Each rw In xlWsh.Range(DataRange).Rows
        ColRow = xlWsh.Cells(rw.Row, xlWsh.Columns.Count).End(xlToLeft).Column
        If ColRow > MaxCol Then
            MaxCol = ColRow
        End If
    Next
    MaxColInXlRange = MaxCol
    'End Find Last Row

End Function

情况是我有 20 列数据。我在 B 列中有位置值，在 I 和 O 列中有比较数据。我已经有了宏来针对整个工作表执行我想要的操作，但想根据 B 列中的位置值分解我的结果。

我确信有一种简单的方法可以做到这一点，但由于我的想象力有限，我似乎无法弄清楚。

想法？

Answer 1

我在跟踪您要完成的工作时遇到了一些麻烦，但我收集到您正在尝试将一个列中的值与另一列中的值进行比较？

如果是这样，我会尝试类似的东西

last1 = Range("B" & Rows.Count).End(xlUp).Row
last2 = Range("I" & Rows.Count).End(xlUp).Row

For i = 2 to last1        
    For j = 2 to last2
        'Check if val in 'B' matches val in 'I'
        If(Range("B" & i).value = Range("I" & j).value) then
            'If match then colour cell
            Range("I" & j).Interior.Color = RGB(0, 255, 0)
        End If
    next j
next i