プライベートSub Worksheet_changeからactivecellと同じ行にあるセルの値を確認できるサブプロシージャ

Question

Excel VBAの使用は比較的新しいです。教師の作業負荷を軽減できるように、私は学校での評価のための分析ツールを作成しました。スプレッドシートが非常に大きくなり、必要な複数のシナリオと条件付き書式設定のためスプレッドシートが遅く問題になった。

私は次のようにPrivate Sub worksheet_change (ByVal Target As Range)を持っています。

Private Sub Worksheet_Change(ByVal Target As Range) 

    If (Cells(3, Target.Column) = "AUT" Or Cells(3, Target.Column) = "SPR" Or Cells(3, Target.Column) = "SUM") And Target.Column >= 1 And Target.Row >= 4 And Target.Row <= 500 Then 

     If Cells(Target.Row, "M").Value = "MLD" And Cells(Target.Row, "ET").Value = 1 And Cells(Target.Row, Target.Column - 1) = 2 Then   
     Call Year1Start   
     End If  
    End If  
    End Sub 

私はSubプロシージャを作成しようとしましたが、無駄にしました：

Sub Year1Start() 

     If Cells(Target.Row, "EM").Value = 0.4 Then 

     Call Y1StartY2DataEntry040 

    End If 

    End Sub 

    Sub Y1StartY2DataEntry040() 

    'check the various outputs for year 1 start with year 2 data entry: 
    'y1=0.4  R0.42,Y0.44,G0.46, B0.48 

    ActiveCell.Offset(0, 1).Select 

    If ActiveCell.Value < 0.44 Then 
    ActiveCell.Offset(0, 1).Select 
    ActiveCell.Value = "R" 
    ActiveCell.Offset(0, -2).Select 
    ActiveCell.Interior.Color = RGB(255, 0, 0) 
    ActiveCell.Offset(0, 1).Select 
    End If 

    If ActiveCell.Value = 0.44 Then 
    ActiveCell.Offset(0, 1).Select 
    ActiveCell.Value = "Y" 
    ActiveCell.Offset(0, -2).Select 
    ActiveCell.Interior.Color = RGB(255, 255, 51) 
    ActiveCell.Offset(0, 1).Select 
    End If 

    If ActiveCell.Value = 0.46 Then 
    ActiveCell.Offset(0, 1).Select 
    ActiveCell.Value = "G" 
    ActiveCell.Offset(0, -2).Select 
    ActiveCell.Interior.Color = RGB(51, 225, 51) 
    ActiveCell.Offset(0, 1).Select 
    End If 

    If ActiveCell.Value >= 0.48 Then 
    ActiveCell.Offset(0, 1).Select 
    ActiveCell.Value = "B" 
    ActiveCell.Offset(0, -2).Select 
    ActiveCell.Interior.Color = RGB(55, 142, 225) 
    ActiveCell.Offset(0, 1).Select 
    End If 

    If ActiveCell.Value = isblank Then 
    ActiveCell.Offset(0, -1).Select 
    ActiveCell.Interior.ColorIndex = 0 
    ActiveCell.Offset(0, 2).Select 
    ActiveCell.Value = "" 
    ActiveCell.Offset(0, -2).Select 
    End If 

    End Sub 

は基本的に私は、それは新しいプロシージャを呼び出して値がtrueであるかどうかを確認する必要があります。

私はこれまでに手続きが大きかったので、この方法で行う必要があります。

Answer 1

私はいくつかの良いインデントとさまざまなプログラミングテクニックを利用して、Worksheet_Changeの中の1つの手順で確実にこれを達成できるように、コードをリファクタリングすることに決めました。

具体的には、Select Caseの私の使用を注意してください（読みやすさ）の複数のIfブロックと私の代わりにActiveCellとSelectを使用するのでは、オブジェクトを直接操作する方法。

Private Sub Worksheet_Change(ByVal Target As Range) 

Select Case Cells(3, Target.Column) 

    Case Is = "AUT", "SPR", "SUM" 

     If Target.Column >= 1 And Target.Row >= 4 And Target.Row <= 500 Then 

      If Cells(Target.Row, "M").Value = "MLD" Then 

       If Cells(Target.Row, "ET").Value = 1 And Cells(Target.Row, Target.Column - 1) = 2 Then 

        If Cells(Target.Row, "EM").Value = 0.4 Then 

         Dim sVal As String, r As Integer, g As Integer, b As Integer 

         Select Case Target.Offset(, 1).Value 

          Case Is < 0.44: sVal = "R": r = 255: g = 0: b = 0 

          Case Is = 0.44: sVal = "Y": r = 255: g = 255: b = 51 

          Case Is = 0.46: sVal = "G": r = 51: g = 225: b = 51 

          Case Is >= 0.48: sVal = "B": r = 55: g = 142: b = 225 

          Case Is = "": sVal = "": 

         End Select 

         Target.Offset(, 2).Value = sVal 

         If Len(Target.Offset(, 1)) = 0 Then 
          Target.Interior.ColorIndex = 0 
         Else 
          Target.Interior.Color = RGB(r, g, b) 
         End If 

        End If 

       End If 

      End If 

     End If 

End Select 

End Sub 

注 - ダウン、このコードをトリミングする方法は2で条件付きコードの中の検査のフラグ列としてスプレッドシートにヘルパーカラムを使用することで、第3 ブロック。