錯誤處理Excel VBA

-1

所以我今天寫了這一整天，我發現它失敗了，如果沒有檢測到顏色。

你們認爲我應該怎麼做？

我試過一個錯誤處理整個事情，但它沒有奏效。

代碼：

Sub UpdateTemplate_off_Color() 

Sheets("test code").Activate 
'R-203 
Text203 = Sheets("Original Data").Range("I24") 
'R-18 
Text18 = Sheets("Original Data").Range("I22") 
'R-19 
Text19 = Sheets("Original Data").Range("L26") 
'R-21 
Text21 = Sheets("Original Data").Range("I28") 
'R-59 
Text59 = Sheets("Original Data").Range("I30") 
'R-650 
Text650 = Sheets("Original Data").Range("I40") 
'R-1161 
Text1161 = Sheets("Original Data").Range("I38") 


    Dim rCell As Range 
    Dim lColor As Long 
    Dim rColored As Range 

'code updated with a goto label if error, error only happens when color is not found 
'fix code to not bug out if no colors found june30th 2:42pm 

    'R-203 - TEXT1 
    Color203 = RGB(153, 204, 255) 
    'R-18 - TEXT2 
    Color18 = RGB(204, 255, 255) 
    'R-19 - TEXT3 
    Color19 = RGB(192, 192, 192) 
    'R-21 - TEXT4 
    Color21 = RGB(255, 128, 128) 
    'R-59 - TEXT5 
    Color59 = RGB(204, 204, 255) 
    'R-650 - TEXT6 
    Color650 = RGB(255, 153, 0) 
    'R-1161 - TEXT7 
    Color1161 = RGB(255, 204, 0) 


'R-203 - TEXT203 
Range(Range("A2"), Range("A2").End(xlDown)).Select 
    Set rColored = Nothing 
    For Each rCell In Selection 
     If rCell.Interior.Color = Color203 Then 
      If rColored Is Nothing Then 
       Set rColored = rCell 
      Else 
       Set rColored = Union(rColored, rCell) 
      End If 
     End If 
    Next 

On Error GoTo skipthispart203: 
     rColored.Select 
     Selection.Offset(0, 11).Select 

     For Each i In Selection 
      'i.Value = i.Value & Text 
      'i.Value = Text & i.Value 
      i.Value = Text203 
     Next i 
skipthispart203: 

    Set rCell = Nothing 
    Set rColored = Nothing 

'R-18 - TEXT18 
Range(Range("A2"), Range("A2").End(xlDown)).Select 
    Set rColored = Nothing 
    For Each rCell In Selection 
     If rCell.Interior.Color = Color18 Then 
      If rColored Is Nothing Then 
       Set rColored = rCell 
      Else 
       Set rColored = Union(rColored, rCell) 
      End If 
     End If 
    Next 

On Error GoTo skipthispart18: 
     rColored.Select 
     Selection.Offset(0, 11).Select 

     For Each i In Selection 
      'i.Value = i.Value & Text 
      'i.Value = Text & i.Value 
      i.Value = Text18 
     Next i 
skipthispart18: 

    Set rCell = Nothing 
    Set rColored = Nothing 

'R-19 - TEXT19 
Range(Range("A2"), Range("A2").End(xlDown)).Select 
    Set rColored = Nothing 
    For Each rCell In Selection 
     If rCell.Interior.Color = Color19 Then 
      If rColored Is Nothing Then 
       Set rColored = rCell 
      Else 
       Set rColored = Union(rColored, rCell) 
      End If 
     End If 
    Next 

On Error GoTo skipthispart19: 
     rColored.Select 
     Selection.Offset(0, 11).Select 

     For Each i In Selection 
      'i.Value = i.Value & Text 
      'i.Value = Text & i.Value 
      i.Value = Text19 
     Next i 
skipthispart19: 

    Set rCell = Nothing 
    Set rColored = Nothing 

'R-21 - TEXT21 
Range(Range("A2"), Range("A2").End(xlDown)).Select 
    Set rColored = Nothing 
    For Each rCell In Selection 
     If rCell.Interior.Color = Color21 Then 
      If rColored Is Nothing Then 
       Set rColored = rCell 
      Else 
       Set rColored = Union(rColored, rCell) 
      End If 
     End If 
    Next 

On Error GoTo skipthispart21: 
     rColored.Select 
     Selection.Offset(0, 11).Select 

     For Each i In Selection 
      'i.Value = i.Value & Text 
      'i.Value = Text & i.Value 
      i.Value = Text21 
     Next i 
skipthispart21: 

    Set rCell = Nothing 
    Set rColored = Nothing 

'R-59 - TEXT59 
Range(Range("A2"), Range("A2").End(xlDown)).Select 
    Set rColored = Nothing 
    For Each rCell In Selection 
     If rCell.Interior.Color = Color59 Then 
      If rColored Is Nothing Then 
       Set rColored = rCell 
      Else 
       Set rColored = Union(rColored, rCell) 
      End If 
     End If 
    Next 

On Error GoTo skipthispart59: 
     rColored.Select 
     Selection.Offset(0, 11).Select 

     For Each i In Selection 
      'i.Value = i.Value & Text 
      'i.Value = Text & i.Value 
      i.Value = Text59 
     Next i 
skipthispart59: 

    Set rCell = Nothing 
    Set rColored = Nothing 

'R-650 - TEXT650 
Range(Range("A2"), Range("A2").End(xlDown)).Select 
    Set rColored = Nothing 
    For Each rCell In Selection 
     If rCell.Interior.Color = Color650 Then 
      If rColored Is Nothing Then 
       Set rColored = rCell 
      Else 
       Set rColored = Union(rColored, rCell) 
      End If 
     End If 
    Next 

On Error GoTo skipthispart650: 
     rColored.Select 
     Selection.Offset(0, 11).Select 

     For Each i In Selection 
      'i.Value = i.Value & Text 
      'i.Value = Text & i.Value 
      i.Value = Text650 
     Next i 
skipthispart650: 

    Set rCell = Nothing 
    Set rColored = Nothing 

'R-1161 - TEXT1161 
Range(Range("A2"), Range("A2").End(xlDown)).Select 
    Set rColored = Nothing 
    For Each rCell In Selection 
     If rCell.Interior.Color = Color1161 Then 
      If rColored Is Nothing Then 
       Set rColored = rCell 
      Else 
       Set rColored = Union(rColored, rCell) 
      End If 
     End If 
    Next 

On Error GoTo skipthispart1161: 
     rColored.Select 
     Selection.Offset(0, 11).Select 

     For Each i In Selection 
      'i.Value = i.Value & Text 
      'i.Value = Text & i.Value 
      i.Value = Text1161 
     Next i 
skipthispart1161: 

    Set rCell = Nothing 
    Set rColored = Nothing 


End Sub

如果你有興趣，這裏是色彩搭配特定值的所有行中的B欄上面的代碼依賴於該代碼的代碼。但是如果列全部是空白的呢？我需要爲這種情況做計劃。

Public Sub changecolor() 

Range(Range("B2"), Range("B2").End(xlDown)).Select 

'remove past colors 
    ActiveSheet.Cells.Interior.ColorIndex = xlNone 

Set MyPlage = Selection 

For Each Cell In MyPlage 

Select Case Cell.Value 

Case Is = "R-203" 
Cells(Cell.Row, "A").Interior.ColorIndex = 37 
Cells(Cell.Row, "B").Interior.ColorIndex = 37 

Case Is = "M-946" 
Cells(Cell.Row, "A").Interior.ColorIndex = 45 
Cells(Cell.Row, "B").Interior.ColorIndex = 45 

Case Is = "R-1161" 
Cells(Cell.Row, "A").Interior.ColorIndex = 44 
Cells(Cell.Row, "B").Interior.ColorIndex = 44 

Case Is = "r-650" 
Cells(Cell.Row, "A").Interior.ColorIndex = 45 
Cells(Cell.Row, "B").Interior.ColorIndex = 45 
Case Is = "R-650" 
Cells(Cell.Row, "A").Interior.ColorIndex = 45 
Cells(Cell.Row, "B").Interior.ColorIndex = 45 

Case Is = "R-59" 
Cells(Cell.Row, "A").Interior.ColorIndex = 24 
Cells(Cell.Row, "B").Interior.ColorIndex = 24 

Case Is = "R-21" 
Cells(Cell.Row, "A").Interior.ColorIndex = 22 
Cells(Cell.Row, "B").Interior.ColorIndex = 22 

Case Is = "R-19" 
Cells(Cell.Row, "A").Interior.ColorIndex = 15 
Cells(Cell.Row, "B").Interior.ColorIndex = 15 

Case Is = "R-18" 
Cells(Cell.Row, "A").Interior.ColorIndex = 20 
Cells(Cell.Row, "B").Interior.ColorIndex = 20 

Case Else 
Cell.EntireRow.Interior.ColorIndex = xlNone 


End Select 
Next 
End Sub

來源

2015-06-30 DeerSpotter

使用'如果不rColored是Nothing Then' - 你不需要錯誤因爲只需測試是否找到任何單元格就更容易了。 –

此：

'R-203 - TEXT203 
Range(Range("A2"), Range("A2").End(xlDown)).Select 
    Set rColored = Nothing 
    For Each rCell In Selection 
     If rCell.Interior.Color = Color203 Then 
      If rColored Is Nothing Then 
       Set rColored = rCell 
      Else 
       Set rColored = Union(rColored, rCell) 
      End If 
     End If 
    Next 

On Error GoTo skipthispart203: 
     rColored.Select 
     Selection.Offset(0, 11).Select 

     For Each i In Selection 
      'i.Value = i.Value & Text 
      'i.Value = Text & i.Value 
      i.Value = Text203 
     Next i 
skipthispart203: 

    Set rCell = Nothing 
    Set rColored = Nothing

在功能上是一樣的：

Dim rngSrch as Range, c As Range 

Set rngSrch = Range(Range("A2"), Range("A2").End(xlDown)) 
For each c In rngSrch.Cells 
    If c.Interior.Color = Color203 Then 
     c.offset(0,11).Value = Text203 
    End If 
Next c

除非有別的東西你要離開了。

而且因爲你重複相同的塊，你可以在一個子包，並從你的主UpdateTemplate_off_Color子叫它：

Sub UpdateTemplate_off_Color() 

    Dim shtOD As Worksheet, shtTC As Worksheet 
    Dim rngSrch As Range 

    Set shtTC = Sheets("test code") 
    Set shtOD = Sheets("Original Data") 

    Set rngSrch = shtTC.Range(shtTC.Range("A2"), _ 
           shtTC.Range("A2").End(xlDown)) 

    TextByColor rngSrch, RGB(153, 204, 255), shtOD.Range("I24").Value 'R-203 
    TextByColor rngSrch, RGB(204, 255, 255), shtOD.Range("I22").Value 'R-18 
    TextByColor rngSrch, RGB(192, 192, 192), shtOD.Range("L26").Value 'R-19 
    TextByColor rngSrch, RGB(255, 128, 128), shtOD.Range("I28").Value 'R-21 
    TextByColor rngSrch, RGB(204, 204, 255), shtOD.Range("I30").Value 'R-59 
    TextByColor rngSrch, RGB(255, 153, 0), shtOD.Range("I40").Value 'R-650 
    TextByColor rngSrch, RGB(255, 204, 0), shtOD.Range("I38").Value 'R-1161 

End Sub 

Sub TextByColor(rngSrch As Range, clr As Long, txt) 
    Dim c As Range 
    For Each c In rngSrch.Cells 
     If c.Interior.Color = clr Then 
      c.Offset(0, 11).Value = txt 
     End If 
    Next c 
End Sub

來源

2015-06-30 23:31:12

我對運行Sub TextByColor感到困惑，那意味着生病必須每次調用sub？設置rngSrch我不能看到它調用子，即時通訊假設所有這一切都在同一個模塊？ – DeerSpotter

如果c.Interior.Color = Color203然後 c.offset（0,11）.Value = Text203 工作得很好，如果你能解釋你顯示的其他方法會很棒。 – DeerSpotter

查看更新的第1代碼部分 - 如何將獨立的Sub與原始的'UpdateTemplate_off_Color'方法集成。 –

錯誤處理Excel VBA

回答

相關問題