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

基本上我需要检查值是否为真，然后调用新程序。

我需要这样做，因为之前程序太大了。

Answer 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。

If

注意 - 修改此代码的一种方法是使用电子表格中的帮助列作为标志列，在代码中使用第2，第3和第2条件中的条件进行测试。第4个sed块。

一个子过程，它能够从Private Sub Worksheet_change检查与activecell相同的行中的单元格的值

1 个答案: