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