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

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

1 个答案: