我想在更改单元格或单元格范围时自动执行VBA程序，我已尝试使用& quot; Private Sub Worksheet_SelectionChange（ByVal Target As Range）& quot;但程序没有执行。 [英] I want to execute the VBA program automaticly when changing a cell or a cell range, I have tried with "Private Sub Worksheet_SelectionChange(ByVal Target As Range)" but the program does not execute.

问题描述

Sub Calculate_Options()

Dim Metallization As Integer
Dim Terminals As Integer
Dim Coating As Integer

Metallization = Range("H15").Value
Terminals = Range("I15").Value
Coating = Range("I14").Value

If Metallization > 1 Then
 Range("I22:I26") = ""
 MsgBox "Please Select Only One Metalization Type with One Overspray", vbExclamation
End If

If Terminals > 1 Then
 Range("I28:I35") = ""
 MsgBox "Please Select Only One Terminal Type", vbExclamation
End If
 
If Coating > 1 Then
 Range("I36:I37") = ""
 MsgBox "Please Select Only One Coating Type", vbExclamation
End If

If Range("$I$27") = 1 Then
    Range("I23:I26") = ""
    MsgBox "Tin Already Includes Overspray", vbExclamation
End If

If Range("$I$28") = 1 Then
    Range("I23:I27") = ""
    MsgBox "Radial Clamp Already Includes Overspray and Tin", vbExclamation
End If

If Range("$H$21") = "NO" And Range("$I$21") = 1 Then
        Range("$I$21") = ""
        MsgBox "Option Not Available for This Part Number", vbExclamation
   End If
If Range("$H$22") = "NO" And Range("$I$22") = 1 Then
        Range("I22") = ""
        MsgBox "Option Not Available for This Part Number", vbExclamation
   End If
If Range("$H$23") = "NO" And Range("$I$23") = 1 Then
        Range("I23") = ""
        MsgBox "Option Not Available for This Part Number", vbExclamation
   End If
If Range("$H$24") = "NO" And Range("$I$24") = 1 Then
        Range("I24") = ""
        MsgBox "Option Not Available for This Part Number", vbExclamation
   End If
If Range("$H$25") = "NO" And Range("$I$25") = 1 Then
        Range("I25") = ""
        MsgBox "Option Not Available for This Part Number", vbExclamation
   End If
If Range("$H$26") = "NO" And Range("$I$26") = 1 Then
        Range("I26") = ""
        MsgBox "Option Not Available for This Part Number", vbExclamation
   End If
If Range("$H$27") = "NO" And Range("$I$27") = 1 Then
        Range("I27") = ""
        MsgBox "Option Not Available for This Part Number", vbExclamation
   End If
If Range("$H$28") = "NO" And Range("$I$28") = 1 Then
        Range("I28") = ""
        MsgBox "Option Not Available for This Part Number", vbExclamation
   End If
If Range("$H$29") = "NO" And Range("$I$29") = 1 Then
        Range("I29") = ""
        MsgBox "Option Not Available for This Part Number", vbExclamation
   End If
If Range("$H$30") = "NO" And Range("$I$30") = 1 Then
        Range("I30") = ""
        MsgBox "Option Not Available for This Part Number", vbExclamation
   End If
If Range("$H$31") = "NO" And Range("$I$31") = 1 Then
        Range("I31") = ""
        MsgBox "Option Not Available for This Part Number", vbExclamation
   End If
If Range("$H$32") = "NO" And Range("$I$32") = 1 Then
        Range("I32") = ""
        MsgBox "Option Not Available for This Part Number", vbExclamation
   End If
If Range("$H$33") = "NO" And Range("$I$33") = 1 Then
        Range("I33") = ""
        MsgBox "Option Not Available for This Part Number", vbExclamation
   End If
If Range("$H$34") = "NO" And Range("$I$34") = 1 Then
        Range("I34") = ""
        MsgBox "Option Not Available for This Part Number", vbExclamation
   End If
If Range("$H$35") = "NO" And Range("$I$35") = 1 Then
        Range("I35") = ""
        MsgBox "Option Not Available for This Part Number", vbExclamation
   End If
If Range("$H$36") = "NO" And Range("$I$36") = 1 Then
        Range("I36") = ""
        MsgBox "Option Not Available for This Part Number", vbExclamation
   End If
If Range("$H$37") = "NO" And Range("$I$36") = 1 Then
        Range("I37") = ""
        MsgBox "Option Not Available for This Part Number", vbExclamation
   End If
If Range("$H$38") = "NO" And Range("$I$36") = 1 Then
        Range("I38") = ""
        MsgBox "Option Not Available for This Part Number", vbExclamation
   End If
   
    

Dim Ohms As Double
Ohms = Range("B12").Value


If Ohms > 0 And Ohms < 10 Then
    Range("B14") = Round(Ohms, 1)
ElseIf Ohms >= 10 And Ohms < 100 Then
    Range("B14") = Round(Ohms, 0)
ElseIf Ohms >= 100 And Ohms < 1000 Then
    Range("B14") = Round(Ohms / 10, 0) * 10
ElseIf Ohms >= 1000 And Ohms < 10000 Then
    Range("B14") = Round(Ohms / 100, 0) * 100
ElseIf Ohms >= 10000 And Ohms < 100000 Then
    Range("B14") = Round(Ohms / 1000, 0) * 1000
ElseIf Ohms >= 100000 And Ohms < 1000000 Then
    Range("B14") = Round(Ohms / 10000, 0) * 10000
ElseIf Ohms >= 1000000 And Ohms < 10000000 Then
    Range("B14") = Round(Ohms / 100000, 0) * 100000
End If


End Sub

推荐答案

您好，

Worksheet_Change事件与Worksheet_SelectionChange事件不同。如果您希望在更改任何单元格或范围时触发代码，请将代码置于Worsheet_Change事件下。

Worksheet_Change event is different than Worksheet_SelectionChange event. If you want your code to trigger on changing any cell or range then put your code under Worsheet_Change event.

例如：如果您希望代码在更改单元格中的任何值时触发" A1"然后你的代码看起来像这样：

For Example: If you want your code to trigger on changing any value in cell "A1" then your code would look like this:

Private Sub Worksheet_Change(ByVal Target As Range)

On Error GoTo err
If Target.Address = "

A

1"然后
Application.EnableEvents = False

'<键入你的代码或调用你想要执行的函数>

结束如果

错误：Application.EnableEvents = False

End Sub

1" Then Application.EnableEvents = False '<Type your code or call the function which you want to execute> End If err: Application.EnableEvents = False End Sub

这篇关于我想在更改单元格或单元格范围时自动执行VBA程序，我已尝试使用&amp; quot; Private Sub Worksheet_SelectionChange（ByVal Target As Range）&amp; quot;但程序没有执行。的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！