求助 发现二义性的名称 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

838225419

这样试着合并了一下，但是下半部分不能触发事件，拜求各位大师
Private Sub Worksheet_Change(ByVal Target As Range) '自动取客户信息
On Error Resume Next
Dim Rng As Range
Application.EnableEvents = False '禁止触发事件
Set Rng = Range("j5") '你需要的单元格区域
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

'从这里往下不能触发事件
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] = ""
   [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

WANT-T

事件这个东西，知道怎么用以后，就自己慢慢调试，你设计的各种交互方式，别人通过代码不一定能看懂！慢慢调试吧,祝工作顺利！

838225419

WANT-T 发表于 2023-6-20 15:31
事件这个东西，知道怎么用以后，就自己慢慢调试，你设计的各种交互方式，别人通过代码不一定能看懂！慢慢调 ...

拜托大师

边缘码农

不知道是不是你需要的。 求助.rar (20.84 KB, 下载次数: 7)

2023-6-20 17:31 上传

点击文件名下载附件

feilanga

鼠标双击B2单元格

838225419

feilanga 发表于 2023-6-20 18:17
鼠标双击B2单元格

谢谢，让您费心了
不是这样的要求，B2单元格输入后自动取客户信息，执行
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
   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
j5单元格输入数值后自动乘以5，执行
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
这两个程序运行的结果都要，只是如何去掉二定义提示，让程序正常运行（全并或修改）
非常感谢

feilanga

838225419 发表于 2023-6-20 19:20
谢谢，让您费心了
不是这样的要求，B2单元格输入后自动取客户信息，执行
Private Sub Worksheet_Change ...

不同的方式而已，目的达到不就行了

838225419

feilanga 发表于 2023-6-21 09:07
不同的方式而已，目的达到不就行了

但是：电话：O2，卡号M8 如何变为数字，拜求大师

feilanga

838225419 发表于 2023-6-21 09:16
但是：电话：O2，卡号M8 如何变为数字，拜求大师

说清楚点 不懂你的意思