发现二义性的名称 Worksheet_Change(ByVal Target As Range) 求把两个代码合并

838225419

Private Sub Worksheet_Change(ByVal Target As Range) '自动取客户信息
If Target.Address <> "$B$2" Then Exit Sub
Dim Arr, i&, d
Set d = CreateObject("Scripting.Dictionary")
S = Cells(2, 2)
bz = False
For i = 2 To Worksheets("客户资料").Cells(Rows.Count, 1).End(3).Row
    If Worksheets("客户资料").Cells(i, 2) = S Then
       bz = True
       Exit For
    End If
Next i
If Not bz Then
   [g2] = ""
   [j2] = ""
   [o2] = ""
   [d3] = ""
   [k3] = ""
   [a5] = ""
   [d5] = ""
   [f5] = ""
   [g5] = ""
   [h5] = ""
   [i5] = ""
   [j5] = ""
   [k5] = ""
   [n5] = ""
   [c8] = ""
   [g8] = ""
   [m8] = ""

   MsgBox "该车号的客户资料不存在"
Else
Arr = Sheet7.[a1].CurrentRegion
For i = 2 To UBound(Arr)
    If Arr(i, 2) = "" Then Exit For
    d(Arr(i, 2)) = i
Next
If [b2] = "" Then Exit Sub
'End If
i = d(Target.Value)
[g2] = Arr(i, 3): [j2] = Arr(i, 4): [o2] = Arr(i, 5): [c8] = Arr(i, 6): [g8] = Arr(i, 7): [m8] = Arr(i, 8)
End If
End Sub


Private Sub Worksheet_Change(ByVal Target As Range)‘单元格A1自动乘以5
On Error Resume Next
Dim Rng As Range
Application.EnableEvents = False '禁止触发事件
Set Rng = Range("a1") '你需要的单元格区域
If Intersect(Target, Rng) Is Nothing Then   '选择单元不在区内就退出
Application.EnableEvents = True '允许触发事件
Exit Sub
End If
On Error GoTo 100
Target.Value = Target.Value * 5
Application.ScreenUpdating = True
100:
If Err.Number = 13 Then
End If
Application.EnableEvents = True '允许触发事件
End Sub

psxk3535028-1

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim Rng As Range
If Target.Address <> "$A$1" Then goto 200  '选择单元不在区内就退出
Application.EnableEvents = False '禁止触发事件
On Error GoTo 100
Target.Value = Target.Value * 5
Application.ScreenUpdating = True
100:
If Err.Number = 13 Then
End If
200
If Target.Address <> "$B$2" Then Application.EnableEvents = True : Exit Sub
Dim Arr, i&, d
Set d = CreateObject("Scripting.Dictionary")
S = Cells(2, 2)
bz = False
For i = 2 To Worksheets("客户资料").Cells(Rows.Count, 1).End(3).Row
    If Worksheets("客户资料").Cells(i, 2) = S Then
       bz = True
       Exit For
    End If
Next i
If Not bz Then
   [g2] = ""
   [j2] = ""
   [o2] = ""
   [d3] = ""
   [k3] = ""
   [a5] = ""
   [d5] = ""
   [f5] = ""
   [g5] = ""
   [h5] = ""
   [i5] = ""
   [j5] = ""
   [k5] = ""
   [n5] = ""
   [c8] = ""
   [g8] = ""
   [m8] = ""

   MsgBox "该车号的客户资料不存在"
Else
Arr = Sheet7.[a1].CurrentRegion
For i = 2 To UBound(Arr)
    If Arr(i, 2) = "" Then Exit For
    d(Arr(i, 2)) = i
Next
If [b2] = "" Then Exit Sub
'End If
i = d(Target.Value)
[g2] = Arr(i, 3): [j2] = Arr(i, 4): [o2] = Arr(i, 5): [c8] = Arr(i, 6): [g8] = Arr(i, 7): [m8] = Arr(i, 8)
End If
Application.EnableEvents = True
End Sub

没看明白
100:
If Err.Number = 13 Then
End If
是什么意思

838225419

psxk3535028-1 发表于 2023-7-13 21:51
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim Rng As Range

谢谢，非常 感谢

838225419

psxk3535028-1 发表于 2023-7-13 21:51
Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
Dim Rng As Range

谢谢，非常感谢