跪求大师帮忙，求VBA程序

838225419

fanyoulin 发表于 2023-6-2 17:02
保存代码里有解密，所以加密就没起作用；

老师您好，麻烦您把“汇总”表在保存的同时，加一下保护，跪求帮忙，拜托拜托

拜托老师再次帮忙，把“汇总”表在保存的同时，加一下保护


补充内容 (2023-6-7 16:13):
拜托拜托

838225419

fanyoulin 发表于 2023-6-2 17:02
保存代码里有解密，所以加密就没起作用；

老师您好， 已经解决了，还是要谢谢老师

838225419

fanyoulin 发表于 2023-5-31 16:19
我什么也没干，只是把你名称重复的代码段注释掉了，就可以运行了；

一个文件中所有的过程名称都不能重 ...

再次麻烦老师，麻烦您给修正以下代码，跪求

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


'Private Sub Worksheet_Change(ByVal Target As Range) '单元格A1自动乘以5
'允许触发事件
End Sub