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中的位置值打破我的結果。
我相信有一個簡單的方法來做到這一點,但是由於我的想象力有限,我似乎無法弄清楚。
想法?
嘗試加入你的代碼,你正在嘗試做修復的問題。 – 0m3r
您的宏當前如何處理列中的所有行?沒有看到你的代碼,我會考慮添加一個IF語句,即IF range(「B1」)。value =「Location」Then ... –
你可以顯示一些代碼嗎? – HelloNewWorld