返回列表 上一主題 發帖

程式碼修改

回復 3# man65boy
UserForm3,UserForm4
都有
  1. Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  2.   a1 = ListBox1.Value
  3.   ActiveCell = IIf(ActiveCell = "", a1, ActiveCell & "、" & a1)
  4. End Sub
複製代碼
表示可複選

建議
UserForm4
  1. Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
  2.     Dim A As String, Ar As Variant
  3.     A = UCase(ListBox1.Value)
  4.     Ar = Filter(Split(ActiveCell, "、"), A)
  5.     If UBound(Ar) = -1 Then  'ListBox1.Value 不在 ActiveCell中
  6.         Ar = Application.Evaluate("VLOOKUP(""" & A & """,產品編號!a:b,2,0)")
  7.         If IsError(Ar) Then  '找不到使用規格或使用規格=""
  8.             MsgBox A & " 找不到使用規格 或 使用規格 =  """""
  9.         Else
  10.             T = IIf(T <> "", T & "、" & MM, MM)
  11.             ActiveCell = UCase(IIf(ActiveCell = "", A, ActiveCell & "、" & A))
  12.         End If
  13.     Else
  14.         MsgBox A & "已選擇"
  15.     End If
  16. End Sub
複製代碼
工作表模組
  1. Private Sub Worksheet_Change(ByVal Target As Range)
  2.     Ex Target, False
  3. End Sub
  4. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  5.     Ex Target, True
  6. End Sub
  7. Private Sub Ex(ByVal Target As Range, Form_Show As Boolean)
  8.     Application.EnableEvents = False
  9.     With Target
  10.         If .Count = 1 And .Row >= 2 Then
  11.             If .Column = 6 Then
  12.                編號 .Cells, Sheets("產品編號")
  13.                If Form_Show Then UserForm4.Show False
  14.             ElseIf .Column = 13 Then
  15.                 編號 .Cells, Sheets("Sheet1")
  16.                 If Form_Show Then UserForm3.Show False
  17.             End If
  18.         End If
  19.     End With
  20.     Application.EnableEvents = True
  21. End Sub
  22. Private Sub 編號(ByVal Target As Range, Sh As Worksheet)
  23.     Dim Ar As Variant, e As Variant, MM As Variant, T As String
  24.     Dim Rng As Range
  25.     Set Rng = Sh.Range("A:B")
  26.     Ar = Split(Target, "、")
  27. Ag:
  28.     For Each e In Ar
  29.         MM = Application.Evaluate("VLOOKUP(""" & e & """," & Rng.Address(, , , 1, 1) & ",2,0)")
  30.         If IsError(MM) Then Exit For
  31.         T = IIf(T <> "", T & "、" & MM, MM)
  32.     Next
  33.     If IsError(MM) Then GoTo Er:
  34.     If Sh.Name = "產品編號" Then
  35.         Target.Offset(, 1) = T
  36.     Else
  37.         Target = T
  38.     End If
  39.     Exit Sub
  40. Er:
  41.     Ar = Filter(Ar, e, False)
  42.     Target = Join(Ar, "、")
  43.     T = ""
  44.     If e = "" Then Exit Sub
  45.     GoTo Ag
  46. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 不要小看自己,因為人有無限的可能。
返回列表 上一主題