Board logo

标题: 已完成 有偿寻找VBA高手处理一个问题 [打印本页]

作者: Bonnie    时间: 2022-3-5 17:24     标题: 已完成 有偿寻找VBA高手处理一个问题

本帖最后由 Bonnie 于 2022-3-7 10:09 编辑

具体报酬:50元人民币或协商
支付方式:支付宝,微信
联系方式:QQ:1044997
有效期限:2022年03月06日之前。
需求描述:
无法上传附件。不知为何。
附件上传到了百度网盘。请求高手帮忙。。。。
    链接: https://pan.baidu.com/s/1D8Uoh2Jpj11dkXiPZOntLg?pwd=i8f7 提取码: i8f7

(1)系统环境(XP/Win2003/Vista/Win7/WIN10,中文版/英文版,专业版/家庭版/精简版,等)
要实现的功能的描述:现有一个VBA文档。。。C3行有四个按钮。。C4行和C7行为手动输入的数据。。C6行是C4行(请输入车架号)数据转换进制得来的。。C9行是C7行(请输入防盗密码)数据转换进制得来的。
。C6行的数据能随着C3行的按钮点击而变化数据。。。。而C9行的数据无法随之变化。。
。C9行的数据需要点击完C3行的四个按钮中的任何一个后重新在C7行输入一次才变化。。。。

有没有什么办法能像C6行一样。。。
VBA代码如下。
  1. Option Explicit
  2. Private Sub CommandButton6_MouseDown(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As Single, ByVal y As Single)
  3.     If Button = 2 And Shift = 4 Then
  4.         UserForm22.Show 0
  5.     End If
  6. End Sub
  7. Private Sub Worksheet_Change(ByVal target As Range)
  8.     On Error Resume Next
  9.     Application.ScreenUpdating = False
  10.     Application.EnableEvents = False
  11.     Dim dic, keys, i
  12.     Dim a As Boolean
  13.     a = False
  14.     If target.Address = "$C$4:$D$4" Or target.Address = "$C$4" Then
  15.         Sheet1.Unprotect 159790
  16.         If Application.WorksheetFunction.CountA(target) <> 0 Then
  17.             target.Value = UCase(target.Value)
  18.             For i = 1 To Len(target.Value)
  19.                 If InStr(".*-/\';/.,=-!@#$%^&*()_+<>?|>< ,。、", Mid(target.Value, i, 1)) > 0 Then
  20.                     a = True
  21.                     Exit For
  22.                 End If
  23.             Next
  24.             If Len(target.Value) <> 17 Or LenB(target.Value) <> 34 Or a Then
  25.                 'If Range("c4").Value <> "请输入车架号" Then
  26.                     变色 target.Offset(1).MergeArea
  27.                 'End If
  28.                 Range("$A$5:$B$5").ClearContents
  29.                 '播放声音
  30.             Else
  31.                 VIN target.Offset(1).MergeArea
  32.                 Range("$A$5:$B$5") = 转换ASCLL码(target.Value)
  33.             End If
  34.         Else
  35.             变色 target.Offset(1).MergeArea
  36.             Range("$A$5:$B$5").ClearContents
  37.             Range("$C$6:$D$6").ClearContents
  38.             Range("c4").Value = "请输入车架号"
  39.         End If
  40.         Sheet1.Protect 159790
  41.     End If
  42.     If target.Address = "$C$7:$D$7" Or target.Address = "$C$7" Then
  43.         Sheet1.Unprotect 159790
  44.         防道密码 Range("$c7")
  45.         Sheet1.Protect 159790
  46.     End If
  47. If CommandButton3.BackColor = vbGreen Or CommandButton4.BackColor = vbGreen Or CommandButton5.BackColor = vbGreen Then
  48.       If Application.WorksheetFunction.CountA(Range("$A$5:$B$5")) <> 0 And Application.WorksheetFunction.CountA(Range("$C$3:$D$3")) <> 0 Then
  49.         Set dic = RangeToDic(Sheet4.Range("a1").CurrentRegion)
  50.         keys = Range("$C$3").Value & ""
  51.         Range("$C$6").Value = "/h:11 /k:4:1003 /b:2EF190" & Range("$A$5") & dic(keys)
  52.       Else
  53.         Range("$C$6:$D$6").Value = ""
  54.       End If
  55. Else
  56.     If Application.WorksheetFunction.CountA(Range("$A$5:$B$5")) <> 0 And Application.WorksheetFunction.CountA(Range("$C$3:$D$3")) <> 0 Then
  57.         Set dic = RangeToDic(Sheet4.Range("a1").CurrentRegion)
  58.         keys = Range("$C$3").Value & ""
  59.         Range("$C$6").Value = "/p:18 /h:11 /k:4:1003 /E:752 /R:652 /b:2EF190" & Range("$A$5") & dic(keys)
  60.     Else
  61.         Range("$C$6:$D$6").Value = ""
  62.     End If
  63. End If
  64.     Application.ScreenUpdating = True
  65.     Application.EnableEvents = True
  66. End Sub
  67. Function 转换ASCLL码(n)
  68.     Dim k As Integer
  69.     Dim i As Integer
  70.     Dim s As String
  71.     Dim keys
  72.     Dim dic
  73.     Set dic = RangeToDic(Sheet4.Range("d1").CurrentRegion)
  74.     k = Len(n)
  75.     For i = 1 To k
  76.         keys = Mid(n, i, 1)
  77.         s = s & dic(keys)
  78.     Next
  79.     转换ASCLL码 = s
  80. End Function
  81. Function RangeToDic(rng As Range, Optional keycol = 1, Optional itemcol = 2)
  82.     '2列标准数据写入字典
  83.     Dim dic
  84.     Dim i As Integer
  85.     Set dic = CreateObject("scripting.dictionary")
  86.     For i = 1 To rng.Rows.Count
  87.         If rng.Cells(i, keycol) <> "" Then
  88.             dic(Trim(rng.Cells(i, keycol)) & "") = rng.Cells(i, itemcol)
  89.         End If
  90.     Next
  91.     Set RangeToDic = dic
  92. End Function
  93. Sub 防道密码(target As Range)
  94.     Dim i As Integer
  95.     Dim a As Boolean
  96.     a = False
  97.     If Application.WorksheetFunction.CountA(target.Resize(1, 2)) <> 0 Then
  98.         target.Value = UCase(target.Value)
  99.         For i = 1 To Len(target.Value)
  100.             If InStr(".*-/\';/.,=-!@#$%^&*()_+<>?|>< ,。、", Mid(target.Value, i, 1)) > 0 Then
  101.                 a = True
  102.                 Exit For
  103.             End If
  104.         Next
  105.      If CommandButton3.BackColor = vbGreen Or CommandButton4.BackColor = vbGreen Or CommandButton5.BackColor = vbGreen Then
  106.         If Len(target.Value) <> 4 Or LenB(target.Value) <> 8 Or InStr(target.Value, "O") > 0 Or InStr(target.Value, "I") > 0 Or a Then
  107.             'If Range("c7").Value <> "请输入防盗密码" Then
  108.                 变色 target.Offset(1).MergeArea
  109.             'End If
  110.             '播放声音
  111.             Range("$A$8").Resize(1, 2).ClearContents
  112.             Range("$C$9").Resize(1, 2).ClearContents
  113.         Else
  114.             KEY target.Offset(1).MergeArea
  115.             Range("$A$8") = 转换ASCLL码(target.Value)
  116.             Range("$C$9").Value = "/h:11 /k:4:1003 /b:3101DF06" & Range("$A8")
  117.         End If
  118.      Else
  119.         If Len(target.Value) <> 4 Or LenB(target.Value) <> 8 Or InStr(target.Value, "O") > 0 Or InStr(target.Value, "I") > 0 Or a Then
  120.             'If Range("c7").Value <> "请输入防盗密码" Then
  121.                 变色 target.Offset(1).MergeArea
  122.             'End If
  123.             '播放声音
  124.             Range("$A$8").Resize(1, 2).ClearContents
  125.             Range("$C$9").Resize(1, 2).ClearContents
  126.         Else
  127.             KEY target.Offset(1).MergeArea
  128.             Range("$A$8") = 转换ASCLL码(target.Value)
  129.             Range("$C$9").Value = "/p:18 /h:11 /k:4:1003 /E:752 /R:652 /b:31010601" & Range("$A8")
  130.         End If
  131.      End If
  132.     Else
  133.         Range("c7").Value = "请输入防盗密码"
  134.         变色 target.Offset(1).MergeArea
  135.         Range("$A$8").Resize(1, 2).ClearContents
  136.         Range("$C$9").Resize(1, 2).ClearContents
  137.     End If
  138. End Sub
  139. Private Sub Worksheet_SelectionChange(ByVal target As Range)
  140.     Application.EnableEvents = False
  141.     If target.Address(0, 0) Like "??:??" Then
  142.         Sheet1.Unprotect 159790
  143.     Else
  144.         Sheet1.Protect 159790
  145.     End If
  146.     If target.Address = "$H$2:$O$9" Then
  147.         Sheet1.Protect 159790
  148.     End If
  149.     Application.EnableEvents = True
  150. End Sub
  151. Private Sub CommandButton3_Click()
  152.     Sheet1.Unprotect 159790
  153.     Me.CommandButton5.BackColor = &H8000000F
  154.     Me.CommandButton3.BackColor = vbGreen
  155.     Me.CommandButton4.BackColor = &H8000000F
  156.     Me.CommandButton7.BackColor = &H8000000F
  157.     [c3] = CommandButton3.Caption
  158.     Sheet1.Protect 159790
  159. End Sub
  160. Private Sub CommandButton4_Click()
  161.     Sheet1.Unprotect 159790
  162.     Me.CommandButton5.BackColor = &H8000000F
  163.     Me.CommandButton3.BackColor = &H8000000F
  164.     Me.CommandButton4.BackColor = vbGreen
  165.     Me.CommandButton7.BackColor = &H8000000F
  166.     [c3] = CommandButton4.Caption
  167.     Sheet1.Protect 159790
  168. End Sub
  169. Private Sub CommandButton5_Click()
  170.     Sheet1.Unprotect 159790
  171.     Me.CommandButton5.BackColor = vbGreen
  172.     Me.CommandButton3.BackColor = &H8000000F
  173.     Me.CommandButton4.BackColor = &H8000000F
  174.     Me.CommandButton7.BackColor = &H8000000F
  175.     [c3] = CommandButton5.Caption
  176.     Sheet1.Protect 159790
  177. End Sub
  178. Private Sub CommandButton7_Click()
  179.     Sheet1.Unprotect 159790
  180.     Me.CommandButton5.BackColor = &H8000000F
  181.     Me.CommandButton3.BackColor = &H8000000F
  182.     Me.CommandButton4.BackColor = &H8000000F
  183.     Me.CommandButton7.BackColor = vbGreen
  184.     [c3] = CommandButton7.Caption
  185.     Sheet1.Protect 159790
  186. End Sub
复制代码

作者: Bonnie    时间: 2022-3-7 10:08

此帖仅作者可见




欢迎光临 批处理之家 (http://www.bathome.net/) Powered by Discuz! 7.2