2015-06-28 134 views
0

首先 - 我不是VBA專家,可以稱自己爲中級excel用戶。我有一個廣泛的VBA宏,我試圖應用到僅有約數百行中的55行。對一列中的單元格中的具有特定值的所有行運行VBA

然後,我想運行相同的宏對另一組具有與以前相同的列中的不同值的行。

我試圖用單獨的宏強制它,但一直不成功。下面的代碼適用於整個工作表中的所有行,但是我想針對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中的位置值打破我的結果。

我相信有一個簡單的方法來做到這一點,但是由於我的想象力有限,我似乎無法弄清楚。

想法?

+3

嘗試加入你的代碼,你正在嘗試做修復的問題。 – 0m3r

+0

您的宏當前如何處理列中的所有行?沒有看到你的代碼,我會考慮添加一個IF語句,即IF range(「B1」)。value =「Location」Then ... –

+0

你可以顯示一些代碼嗎? – HelloNewWorld

回答

0

我遇到了一些麻煩,你試圖完成什麼,但我正在收集你試圖比較一個柱子中的值與另一個柱子中的值嗎?

如果是的話我會嘗試像

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 
相關問題