为什么工作表的代码更改不起作用?

时间:2020-06-23 03:10:11

标签: excel vba

我为数据验证列编写了一些代码,以自动生成单元格,这似乎是第一次工作,但是在关闭文件并再次打开后,它不起作用。

谢谢您的帮助

Private Sub Worksheet_Change(ByVal Target As Range)

 On Error GoTo ErrHandler
  Application.EnableEvents = False


Dim catCode As String

If Target.Cells.Count <> 1 Then Exit Sub
If Target.Column = 2 Then

    catCode = Target.Value
    Select Case catCode
    
    Case "AUTOMATIC LEVEL", "DIGITAL LEVEL"
    Target.Offset(0, 7) = "19/99"
    Target.Offset(0, 8) = 1

    Case "BAROMETER", "THERMOMETER"
    Target.Offset(0, 7) = "24/99"
    Target.Offset(0, 8) = 1
    
    Case "BRACKET BUBBLE"
    Target.Offset(0, 7) = "23/99"
    Target.Offset(0, 8) = 0.5
    
    Case "CARPENTER LEVEL", "REFLECTOR POLE"
    Target.Offset(0, 7) = "23/99"
    Target.Offset(0, 8) = 0.5
    
        
    Case "CLINOMETER", "TRIBRACH"
    Target.Offset(0, 7) = "23/99"
    Target.Offset(0, 8) = 1
    
    Case "DIPMETER"
    Target.Offset(0, 7) = "18/99"
    Target.Offset(0, 8) = 1
    
    
    Case "DIGITAL MEASURING POLE"
    Target.Offset(0, 7) = "18/99"
    Target.Offset(0, 8) = 1
    
    Case "FIBRE GLASS / LENEN TAPE"
    Target.Offset(0, 7) = "18/99"
    Target.Offset(0, 8) = 1
    
    Case "STEEL POCKET MEASURING TAPE"
    Target.Offset(0, 7) = "18/99"
    Target.Offset(0, 8) = 1
    
    Case "STEEL TAPE", "STEEL RULER", "STILON TAPE"
    Target.Offset(0, 7) = "18/99"
    Target.Offset(0, 8) = 1
    
    
    Case "DISTOMETER"
    Target.Offset(0, 7) = "27/99"
    Target.Offset(0, 8) = 2
    
    Case "GPS"
    Target.Offset(0, 7) = "21/99"
    Target.Offset(0, 8) = 1
    
    Case "HAND HELD LASER METER", "TOTAL STATION", "TOTAL STATION WITH REFLECTORLESS"
    Target.Offset(0, 7) = "20/99"
    Target.Offset(0, 8) = 1
    
    Case "LEVELLING STAFF - TELESCOPIC", "LEVELLING STAFF - NON BARCODE", "LEVELLING STAFF"
    Target.Offset(0, 7) = "22/99"
    Target.Offset(0, 8) = 1
    
    Case "MEASURING WHEEL"
    Target.Offset(0, 7) = "3/00"
    Target.Offset(0, 8) = 1
    
    Case "PLANIMETER"
    Target.Offset(0, 7) = "26/99"
    Target.Offset(0, 8) = 1
    
    Case "PLOTTER"
    Target.Offset(0, 7) = "28/99"
    Target.Offset(0, 8) = 1
    
    Case "SPRING BALANCE"
    Target.Offset(0, 7) = "24/99"
    Target.Offset(0, 8) = 2
    
    Case "EDM", "THEODOLITE"
    Target.Offset(0, 7) = "N/A"
    Target.Offset(0, 8) = 1
    
    
    End Select
Else
Exit Sub

End If
ErrHandler:
   Application.EnableEvents = True


End Sub

1 个答案:

答案 0 :(得分:0)

Application.EnableEvents = False块中移动If Target.Column = 2将防止您的代码在不重置Application.EnableEvents标志的情况下退出。随着将来代码的更改(尤其是在使用Application.EnableEvents语句时),管理Exit Sub标志可能会成为问题。避免此问题的另一种方法是与行为逻辑分开处理Application.EnableEvents标志管理……之类。

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.EnableEvents = False

On Error Resume Next     
    LoadCells Target

    Application.EnableEvents = True

End Sub

Private Sub LoadCells(ByVal Target As Range)

Dim catCode As String

If Target.Cells.Count <> 1 Then Exit Sub
If Target.Column = 2 Then

    catCode = Target.Value
    Select Case catCode
    
    Case "AUTOMATIC LEVEL", "DIGITAL LEVEL"
    Target.Offset(0, 7) = "19/99"
    Target.Offset(0, 8) = 1

    Case "BAROMETER", "THERMOMETER"
    Target.Offset(0, 7) = "24/99"
    Target.Offset(0, 8) = 1
    
    Case "BRACKET BUBBLE"
    Target.Offset(0, 7) = "23/99"
    Target.Offset(0, 8) = 0.5
    
    Case "CARPENTER LEVEL", "REFLECTOR POLE"
    Target.Offset(0, 7) = "23/99"
    Target.Offset(0, 8) = 0.5
    
        
    Case "CLINOMETER", "TRIBRACH"
    Target.Offset(0, 7) = "23/99"
    Target.Offset(0, 8) = 1
    
    Case "DIPMETER"
    Target.Offset(0, 7) = "18/99"
    Target.Offset(0, 8) = 1
    
    
    Case "DIGITAL MEASURING POLE"
    Target.Offset(0, 7) = "18/99"
    Target.Offset(0, 8) = 1
    
    Case "FIBRE GLASS / LENEN TAPE"
    Target.Offset(0, 7) = "18/99"
    Target.Offset(0, 8) = 1
    
    Case "STEEL POCKET MEASURING TAPE"
    Target.Offset(0, 7) = "18/99"
    Target.Offset(0, 8) = 1
    
    Case "STEEL TAPE", "STEEL RULER", "STILON TAPE"
    Target.Offset(0, 7) = "18/99"
    Target.Offset(0, 8) = 1
    
    
    Case "DISTOMETER"
    Target.Offset(0, 7) = "27/99"
    Target.Offset(0, 8) = 2
    
    Case "GPS"
    Target.Offset(0, 7) = "21/99"
    Target.Offset(0, 8) = 1
    
    Case "HAND HELD LASER METER", "TOTAL STATION", "TOTAL STATION WITH REFLECTORLESS"
    Target.Offset(0, 7) = "20/99"
    Target.Offset(0, 8) = 1
    
    Case "LEVELLING STAFF - TELESCOPIC", "LEVELLING STAFF - NON BARCODE", "LEVELLING STAFF"
    Target.Offset(0, 7) = "22/99"
    Target.Offset(0, 8) = 1
    
    Case "MEASURING WHEEL"
    Target.Offset(0, 7) = "3/00"
    Target.Offset(0, 8) = 1
    
    Case "PLANIMETER"
    Target.Offset(0, 7) = "26/99"
    Target.Offset(0, 8) = 1
    
    Case "PLOTTER"
    Target.Offset(0, 7) = "28/99"
    Target.Offset(0, 8) = 1
    
    Case "SPRING BALANCE"
    Target.Offset(0, 7) = "24/99"
    Target.Offset(0, 8) = 2
    
    Case "EDM", "THEODOLITE"
    Target.Offset(0, 7) = "N/A"
    Target.Offset(0, 8) = 1
    
    
    End Select
Else
    Exit Sub

End If


End Sub