返回列表 上一主題 發帖

[發問] 求解!!資料一對多的驗證

GBKEE

帖子
5923 
主題
13 
精華
1 
積分
5986 
點名
0  
作業系統
win10 
軟體版本
Office 2010 
閱讀權限
150 
性別
男 
來自
台灣基隆 
註冊時間
2010-5-1 
最後登錄
2022-1-23 

2017 雞年全勤獎章2016猴年全勤獎章2015羊年全勤獎章2014馬年全勤獎章2013蛇年全勤獎章2012龍年全勤獎章論壇貢獻勳章熱烈參與勳章2011兔年全勤獎章
1# 跳轉到 »
發表於 2016-6-19 08:25 | 顯示全部帖子
本帖最後由 GBKEE 於 2016-6-22 05:00 編輯

回復 3# bsy4life


   
順便請教一下combobox無法用滑鼠滾動是要怎麼改

不是有方向鍵可用

work 表單模組程式碼試試看
TextBoxProductNumber,TextBoxMachineNumber,ComboBoxProcess
皆改為 ComboBox 的控制項 其 BoundColumn 屬性 請指定=1
  1. Dim d As Object, Msg As Boolean  '這表單模組 的私用變數
  2. Private Sub UserForm_Initialize()
  3.      TextBoxWorkOrderNumber = New_TextBoxWorkOrderNumber
  4.      TextBoxProductNumber_MakeList
  5.      TextBoxMachineNumber_MakeList
  6.      Msg = True
  7. End Sub
  8. Private Sub TextBoxProductNumber_Change()
  9.    With ComboBoxProcess  ' 製程 控制項
  10.         .Clear
  11.         If TextBoxProductNumber.ListIndex > -1 Then
  12.             If d(TextBoxProductNumber.Value).Rows.Count = 1 Then
  13.                 .AddItem d(TextBoxProductNumber.Value).Cells(2)  '料號只有一個
  14.             Else
  15.                 .List = d(TextBoxProductNumber.Value).Columns(2).Value '相同料號 不只一個  的製程範圍
  16.             End If
  17.             .ListIndex = 0
  18.         End If
  19.     End With
  20.     xChicked
  21. End Sub
  22. Private Sub ComboBoxProcess_Change()
  23.     LabeExceptTimeShow.Caption = ""
  24.     LabelProcessTimeShow.Caption = ""
  25.     With ComboBoxProcess
  26.         If .ListIndex > -1 Then
  27.             ' ***  d(TextBoxProductNumber.Value) ->Range 物件***
  28.             LabeExceptTimeShow.Caption = d(TextBoxProductNumber.Value).Cells(.ListIndex + 1, "C")
  29.             LabelProcessTimeShow.Caption = d(TextBoxProductNumber.Value).Cells(.ListIndex + 1, "D")
  30.         End If
  31.     End With
  32.     xChicked
  33. End Sub
  34. Private Sub TextBoxMachineNumber_Change() '帶入機器型號的資料
  35.     With TextBoxMachineNumber
  36.         LabelMachineShow.Caption = ""
  37.         If .ListIndex > -1 Then LabelMachineShow.Caption = .List(.ListIndex, 1)
  38.     End With
  39.     xChicked
  40. End Sub
  41. Private Sub TextBoxWorkOrderNumber_Change()
  42.     xChicked
  43. End Sub

  45. Private Sub CommandButtonSend_Click()
  46. Dim Rng As Range, BtnCode As Integer
  47.     If MsgBox("新增派工  - " & TextBoxWorkOrderNumber, vbYesNo + 16 * 2, "資料送出") = vbNo Then Exit Sub
  48.     With Sheets("新增派工")
  49.         Set Rng = .Range("A1").End(xlDown)
  50.         If Rng.Row = Rows.Count Then Set Rng = .Range("A1")
  51.     End With
  52.     With Rng.Offset(1)
  53.         .Cells(1, 1) = TextBoxWorkOrderNumber.Value '工單編號
  54.         .Cells(1, 2) = TextBoxProductNumber.Value '料號
  55.         .Cells(1, 3) = ComboBoxProcess.Text  '製程
  56.         .Cells(1, 4) = TextBoxMachineNumber.Value  '機器編號
  57.         .Cells(1, 5) = LabelMachineShow.Caption  '機器型號
  58.         .Cells(1, 6) = LabeExceptTimeShow.Caption '除外工時
  59.         .Cells(1, 7) = LabelProcessTimeShow.Caption '單次工時
  60.     End With
  61.     TextBoxProductNumber.ListIndex = -1
  62.     TextBoxMachineNumber.ListIndex = -1
  63.     ComboBoxProcess.ListIndex = -1
  64.     BtnCode = CreateObject("WScript.Shell").popup("此檔案已自動存檔", 1, Caption)
  65.     ThisWorkbook.Save
  66.     TextBoxWorkOrderNumber = New_TextBoxWorkOrderNumber
  67.     BtnCode = CreateObject("WScript.Shell").popup("工單編號 " & TextBoxWorkOrderNumber, 2, Caption)
  68.     TextBoxWorkOrderNumber.SetFocus
  69. End Sub
  70. Private Sub CommandButtonExit_Click()
  71.     End
  72. End Sub
  73. Private Sub TextBoxProductNumber_MakeList()  '製程工時:料號資料
  74.     Dim Rng As Range
  75.     Set d = CreateObject("scripting.dictionary")   '字典物件
  76.     Set Rng = Sheets("製程工時").Range("A2")
  77.     Do While Rng <> ""
  78.         If d.EXISTS(Rng.Value) Then
  79.             Set d(Rng.Value) = Union(Rng.Resize(, 4), d(Rng.Value)) '料號, 製程, 除外工時,單次工時
  80.         Else
  81.             Set d(Rng.Value) = Rng.Resize(, 4)      '料號, 製程, 除外工時,單次工時
  82.         End If
  83.         Set Rng = Rng.Offset(1)
  84.     Loop
  85.     With TextBoxProductNumber
  86.         .List = d.KEYS
  87.         .ListIndex = 0
  88.     End With
  89. End Sub
  90. Private Sub TextBoxMachineNumber_MakeList()  'List 包含( 機器編號 , 型號)
  91.         With Sheets("機器型號")
  92.                 TextBoxMachineNumber.List = .Range("A2:B" & .Range("A1").End(xlDown).Row).Value
  93.         End With
  94.         TextBoxMachineNumber.ListIndex = 0
  95. End Sub
  96. Private Function New_TextBoxWorkOrderNumber() As String '新增 工單號碼  格式: XXX-1234567890
  97.     Dim New_No As Variant
  98.     With Sheets("新增派工").Range("A1").End(xlDown)
  99.             If .Row > 1 And .Cells <> "" Then
  100.                 New_No = Split(.Cells, "-")
  101.                 New_No(1) = Format(Val(New_No(1)) + 1, "0000000000")
  102.                 New_TextBoxWorkOrderNumber = New_No(0) & "-" & New_No(1)
  103.             End If
  104.     End With
  105. End Function
  106. Private Sub xChicked()  '防呆程式
  107.     Dim BtnCode As Integer, xOrder, Msg As Boolean
  108.     With CommandButtonSend
  109.         .Enabled = TextBoxProductNumber.ListIndex > -1 And ComboBoxProcess.ListIndex > -1 And TextBoxMachineNumber.ListIndex > -1
  110.         .Enabled = .Enabled And Len(Trim(TextBoxWorkOrderNumber)) = 14
  111.         If Len(Trim(TextBoxWorkOrderNumber)) = 14 Then
  112.              xOrder = Split(TextBoxWorkOrderNumber, "-")
  113.             If UBound(xOrder) = 0 Then Msg = True
  114.             If UBound(xOrder) = 1 Then
  115.                 If Len(xOrder(0)) <> 3 Then Msg = True   '前三碼
  116.                 If Len(xOrder(1)) <> 10 Then Msg = True '後十碼
  117.                 If Len(xOrder(1)) = 10 And IsNumeric(xOrder(1)) = False Then Msg = True '後十碼需為數字
  118.             End If
  119.             If Msg Then BtnCode = CreateObject("WScript.Shell").popup("工單編號 錯誤  " & TextBoxWorkOrderNumber & vbLf & "如 :xxx-1234567890", 2, Caption)
  120.             .Enabled = .Enabled And Msg = False
  121.         End If
  122.     End With
  123. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 有願放在心裡，沒有身體力行，正如耕田不播種，皆是空過因緣。
返回列表 上一主題