v03586

回復 7# GBKEE


    感謝大大上面的程式碼...小弟茅塞頓開後....修改程式有出現 #8~#10樓的問題了!!!
    另已經將拉錯的Textbox 改為Listbox 了!!!
    如今有一個問題 想再請教版大  , 請求協助 !!
    不知道為何 , 查詢如圖片中的料號 , 會出現圖中的錯誤
   

下載 (53.14 KB)

2016-10-16 02:35

    還有一個問題  因為『Database-回溫區』與『Database-氮氣櫃』的計算過期時間 應由 “ F欄位「 回溫後使用期限」“ 去優先計算 ( 目前都以 “H 欄位“ )
       僅有『Database-回溫區』與『Database-氮氣櫃』是以“H 欄位“
   因為想再查詢區顯示 距離過期天數, 無奈儲存格冰箱是在“ I 欄位“ 『回溫』 與『氮氣櫃』 皆在“ J 欄位“  , 如此一來 小弟犯難 不知如何修改了
   請求協助

下載 (29.21 KB)

2016-10-16 02:48

   
   最後一個功能可有可無....就是『Database-回溫區』、『Database-回溫區』與『Database-氮氣櫃』
     排序之後不知道可否依照Film PN 去排優先取出順序???  當然還是要依照快過期的先拿
   EX:  
                PN           拿取順序
      40-111111       1
      40-111111       2
      40-111111       3
      40-222222       1
      40-222222       2
      40-222222       3

Film WIP Management_v1.rar (1013.66 KB)

下載次數: 6

2016-10-16 02:45

GBKEE

回復 11# v03586

附檔 看看有意見再提出

Ex.zip (1.06 MB)

下載次數: 9

2016-10-16 14:00

可修改如下 :可是只有一筆資料時它是直著放,不會橫放

1. ReDim Ar(0 To UBound(D(Trim(TextBox2))))
   
2.                 For i = 0 To UBound(D(Trim(TextBox2)))
   
3.                     Ar(i) = D(Trim(TextBox2))(i)  '''附檔如有是 ListBox1 控制項
   
4.                     If i = 2 Then Exit For  '顯示三筆
   
5.                 Next
   
6.                 ListBox1.List = Application.Transpose(Application.Transpose(Ar)) ''附檔如有是 ListBox1 控制項

複製代碼

方法一

1. If D.Count > 0 And D.exists(Trim(TextBox2)) Then
   
2.             If UBound(D(Trim(TextBox2))) = 0 Then
   
3.                 Ar = D(Trim(TextBox2))(0)
   
4.                 With ListBox1
   
5.                     .AddItem
   
6.                    For i = 0 To UBound(Ar)
   
7.                         .List(.ListCount - 1, i) = Ar(i)
   
8.                     Next
   
9.                 End With
   
10.             Else
    
11.                 ReDim Ar(0 To 2)
    
12.                 For i = 0 To UBound(D(Trim(TextBox2)))
    
13.                     Ar(i) = D(Trim(TextBox2))(i)  '''附檔如有是 ListBox1 控制項
    
14.                     If i = 2 Then Exit For  '顯示三筆
    
15.                 Next
    
16.                 ListBox1.List = Application.Transpose(Application.Transpose(Ar)) ''附檔如有是 ListBox1 控制項
    
17.               End If
    
18.         End If

複製代碼

方法二

1. If D.Count > 0 And D.exists(Trim(TextBox2)) Then
   
2.             'ReDim Ar(0 To UBound(D(Trim(TextBox2))))
   
3.             If UBound(D(Trim(TextBox2))) = 0 Then
   
4.                 'Ar = D(Trim(TextBox2))
   
5.                 With Range("A" & Rows.Count).Resize(, UBound(D(Trim(TextBox2))(0)) + 1)
   
6.                     .Value = D(Trim(TextBox2))(0)
   
7.                     ListBox1.List = .Value
   
8.                     .Cells.Clear
   
9.                 End With
   
10.             Else
    
11.                 ReDim Ar(0 To 2)
    
12.                 For i = 0 To UBound(D(Trim(TextBox2)))
    
13.                     Ar(i) = D(Trim(TextBox2))(i)  '''附檔如有是 ListBox1 控制項
    
14.                     If i = 2 Then Exit For  '顯示三筆
    
15.                 Next
    
16.                 ListBox1.List = Application.Transpose(Application.Transpose(Ar)) ''附檔如有是 ListBox1 控制項
    
17.             End If
    
18.         End If

複製代碼

v03586

回復 12# GBKEE


   感謝版大, 這幾天測試後, 有幾個小問題, 煩請版大協助
   1.  輸入格式部分修正
       工號, 因編碼關係 工號可以不要卡固定字元嗎? 有時會是4個數字組成 , 有時一個英文字母+3位數字, 有時兩個英文字母+2位數字
      不變的是都是四碼
      層架編號格式
     修正為 四碼 因應編碼關係, 可否也不要卡固定3位數字嗎??
     LOT 格式
      因為供應商關係每組LOT確定不會重覆, 但是LOT格式不一樣, 可否這邊就不卡格式呢??

2. 計算過期規則不一樣
    如下圖 , 冰箱的計算過期方式 是由 G欄位”膠紙到期日”去判斷距離現在還有多少天到期 ( 冰箱功能沒問題 )
   

下載 (59.56 KB)

2016-10-19 03:09

    但是, 下圖 回溫區與氮氣櫃的計算方式不同, 是由F欄位『回溫後使用期限』,判斷距離現在還有多少天到期(回溫區, 與氮氣櫃 錯誤)
    冰箱資料表、回溫區資料表、氮氣櫃資料表 三張資料表格式僅差一欄『回溫後使用期限』

下載 (77.24 KB)

2016-10-19 03:09

3. 查詢先進先出功能
    查詢冰箱中的距離過期天數, 程式跑成優先拿取順序了 ( 因為資料表只有冰箱格式與其他兩張資料表沒有一樣 ) 如下圖
   至於回溫區與氮氣櫃目前顯示的都是正確的, 只是如Q2問題, 計算位置修改好 就解決問題了
   

下載 (11.75 KB)

2016-10-19 03:14

   部分查詢料號會無法帶出資料 , 如下圖
   

下載 (10.11 KB)

2016-10-19 03:15

GBKEE

回復 13# v03586

不限制格式 Msg = St <> ""
回溫區與氮氣櫃的計算方式不同, 是由F欄位『回溫後使用期限』,判斷距離現在還有多少天到期
可改如下

1. Sub Ex_Ans()
   
2.     Dim St As String, I(1 To 3) As Integer, d As Object, E As Variant, Rng As Range, Ar(), Arr()
   
3.     With Sh
   
4.         St = "膠紙製造日"
   
5.         I(1) = Sh.Rows(1).Find(St, LookIn:=xlValues, LookAt:=xlWhole).Column
   
6.         .Columns(I(1)).TextToColumns Destination:=.Cells(1, I(1)), DataType:=xlDelimited, _
   
7.             FieldInfo:=Array(1, 5), TrailingMinusNumbers:=True  '***(文字格式, 轉換為日期)
   
8.         
   
9.         ' **傳回膠紙到期日的欄位  或  回溫後使用期限 的欄位
   
10.         If InStr(Sh.Name, "冰箱") Then St = "膠紙到期日" Else St = "回溫後使用期限"
    
11.         I(1) = Sh.Rows(1).Find(St, LookIn:=xlValues, LookAt:=xlWhole).Column '**傳回膠紙到期日的欄位
    
12.         If St = "回溫後使用期限" Then
    
13.             Application.Calculation = xlManual      '活頁簿的計算: 手動
    
14.             With .Columns(I(1)).SpecialCells(xlCellTypeConstants)
    
15.                 .Cells = .Value                                  '** 文字格式的數字 轉為數值
    
16.             End With
    
17.             Sh.Calculate               '**Calculate 方法  計算所有開啟的活頁簿、活頁簿中的特定工作表或工作表中指定範圍的儲存格.
    
18.             Application.Calculation = xlAutomatic  '活頁簿的計算: 自動
    
19.         End If
    
20.         If InStr(Sh.Name, "冰箱") Then
    
21.             .Columns(I(1)).TextToColumns Destination:=.Cells(1, I(1)), DataType:=xlDelimited, _
    
22.             FieldInfo:=Array(1, 5), TrailingMinusNumbers:=True  '***(文字格式, 轉換為日期)
    
23.         End If
    
24.         St = "距離過期天數"
    
25.         I(2) = Sh.Rows(1).Find(St, LookIn:=xlValues, LookAt:=xlWhole).Column
    
26.         If .Range("a" & Rows.Count).End(xlUp).Row = 1 Then Exit Sub

複製代碼

3. 查詢先進先出功能 部分查詢料號會無法帶出資料 在11# 有回覆 方法一,方法二
這裡修改

1. Private Sub ComboBox2_Change()
   
2.     Dim Rng As Range, Ar, I As Integer
   
3.     With ListBox1
   
4.         .Clear
   
5.         If ComboBox2.ListIndex = -1 Then Exit Sub
   
6.         Ar = Dt(ComboBox2.Value)
   
7.         If UBound(Ar) = 0 Then
   
8.             .AddItem
   
9.             For I = 0 To UBound(Ar(0))
   
10.                 .List(0, I) = Ar(0)(I)
    
11.             Next
    
12.         Else
    
13.             .List = Application.Transpose(Application.Transpose(Ar))
    
14.         End If
    
15.     End With
    
16. End Sub

複製代碼

v03586

回復 14# GBKEE


    感謝版大!!! 終於解決了!!!

但問題3當中, 查詢先進先出, 冰箱, 距離過期天數一樣還是顯示『優先拿取順序』, 資料表-冰箱『J欄位』 正確應該顯示『I欄位』
  因為資料表回溫區與氮氣櫃, 正確要顯示『J欄位』

另外目前距離過期天數跑出小數點好幾位, 可否顯示小數點後一位就好呢??

不限制格式
請問是這樣修改即可嗎???

1. Private Sub TextBox4_Change()
   
2.     Dim St As String, Msg As Boolean, I As Integer, Ar
   
3. 
   
4.     Msg = St <> ""
   
5. End Sub

複製代碼

GBKEE

回復 15# v03586

1. Private Sub TextBox4_Change()
   
2.      Dim St As String, Msg As Boolean
   
3.         St = Trim(TextBox4)
   
4.         Msg = St <> ""
   
5.        TheMsg 4, Msg
   
6. End Sub

複製代碼

1. Private Sub Lot_Get()
   
2.     Dim I As Long, St As String, B As String, C As String, d As String, Ar(), X As Integer
   
3.     Set Dt = CreateObject("ScripTING.DICTIONARY")
   
4.     'X = IIf(InStr(ActiveSheet.Name, "冰箱"), 9, 10)
   
5.     With Sh
   
6.         X = IIf(InStr(.Name, "冰箱"), 9, 10)
   
7.         I = ShRow
   
8.         Do While .Cells(I, "C") <> ""
   
9.             B = .Cells(I, "B"):    C = .Cells(I, "C"):  d = .Cells(I, "D"):    St = Format(.Cells(I, X), "0.0")
   
10.             If Not Dt.EXISTS(C) Then
    
11.                 Dt(C) = Array(Array(B, C, d, St))
    
12.             Else
    
13.                 Ar = Dt(C)
    
14.                 ReDim Preserve Ar(LBound(Ar) To UBound(Ar) + 1)
    
15.                 Ar(UBound(Ar)) = Array(B, C, d, St)
    
16.                  Dt(C) = Ar
    
17.                  Ar = Dt(C)
    
18.             End If
    
19.             I = I + 1
    
20.         Loop
    
21.     End With

複製代碼

v03586

回復 16# GBKEE


    感謝版大...!! 現如今改掉限制後發現一個問題
   Lot 部分 只能Keyin 一個字元 就往下一格跳
   即使使用刷條碼的方式 , 例如 EE000-0001 , Lot 格式就只帶E , PCS 那欄會跳E000-0001
   回溫後使用期限的時間格式 , 也無法手動修改 如下圖 , 修改一個數字就往下一格跳

下載 (108.64 KB)

2016-10-19 12:41

GBKEE

回復 17# v03586

1. Private Sub TheMsg(T As Integer, Msg As Boolean)   ''** 程式作用  資料輸入格式的檢查
   
2.     '** 乎叫此程式 須帶有 參數1   ,參數2
   
3.     Dim St As String
   
4.     Text_Ar(T).BackColor = IIf(Msg, 正常色, 錯誤色)
   
5.     Text_Msg(T) = Msg
   
6.     ComButton_檢查
   
7.     If ComButton.Enabled Then ListBox1_Change
   
8.     If ComButton.Enabled Then
   
9.         ComButton.SetFocus          '**SetFocus 方法 將駐點移到此物件的執行個體上。
   
10.     ElseIf Msg Then                     '**輸入格式的正確 下移至下一個控制項
    
11. '*****************這裡試著修改 ****************************
    
12.         If T > 2 And T <> 5 And T <> UBound(Text_Ar) Then Text_Ar(T + 1).SetFocus
    
13. '********************************************************
    
14.     End If
    
15. End Sub

複製代碼

回溫後使用期限 格式 與 放入時間格式 Private Sub TextBox9_Change() 是相同的

1. Private Sub TextBox6_Change()
   
2.    Dim St, Msg As Boolean, Ar
   
3.    '格式  日期&時間
   
4.     St = Trim(TextBox6)
   
5.     Msg = UBound(Split(St, "/")) = 2 And UBound(Split(St, " ")) = 1 And UBound(Split(St, ":")) = 1: If Not Msg Then GoTo Ne
   
6.     Ar = Split(St, " ")
   
7.     Msg = IsDate(Ar(0)): If Not Msg Then GoTo Ne
   
8.     Msg = IsDate(Ar(1)): If Not Msg Then GoTo Ne
   
9.     If Msg Then TextBox6 = Format(TextBox6, 日期時間格式)
   
10. Ne:
    
11.     TheMsg 6, Msg
    
12. End Sub

複製代碼

v03586

回復 18# GBKEE


    版大, 我有修改過 工號 跟 層架編號解除限制 , 不知道是否影響那一欄的判斷
工號

1. Private Sub TextBox1_Change()          '** 控制項有變動 : 程式作用  資料格式 的檢查
   
2.     Dim St As String, Msg As Boolean, I As Integer
   
3.     St = Trim(TextBox1)
   
4.     Msg = St <> "" And Len(St) > 1: If Not Msg Then GoTo Ne   '**Msg=False 程式移到 Ne 繼續執行
   
5. Ne:
   
6.      TheMsg 1, Msg
   
7. End Sub

複製代碼

層架編號

1. Private Sub TextBox2_Change()
   
2.    Dim St As String, Msg As Boolean
   
3.     St = Trim(TextBox2)
   
4.     Msg = St <> ""
   
5.     TheMsg 2, Msg
   
6. End Sub

複製代碼

接下來Lot 是依照版大所以修改的

如下版大請我嘗試修改的範圍

1. Private Sub TheMsg(T As Integer, Msg As Boolean)   ''** 程式作用  資料輸入格式的檢查
   
2.     '** 乎叫此程式 須帶有 參數1   ,參數2
   
3.     Dim St As String
   
4.     Text_Ar(T).BackColor = IIf(Msg, 正常色, 錯誤色)
   
5.     Text_Msg(T) = Msg
   
6.     ComButton_檢查
   
7.     If ComButton.Enabled Then ListBox1_Change
   
8.     If ComButton.Enabled Then
   
9.         ComButton.SetFocus          '**SetFocus 方法 將駐點移到此物件的執行個體上。
   
10.     ElseIf Msg Then                     '**輸入格式的正確 下移至下一個控制項
    
11. '*****************這裡試著修改 ****************************
    
12.         If T > 2 And T <> 5 And T <> UBound(Text_Ar) Then Text_Ar(T + 1).SetFocus
    
13. '********************************************************
    
14.     End If
    
15. End Sub

複製代碼

我修改了 紅色字體 , 變成PCS一個字元就跳去下一格, 回溫後使用期限 , 點兩下變成1899年...也是修改一個數字就跳去下一個
  If T > 1 And T <> 4 And T <> UBound(Text_Ar) Then Text_Ar(T + 1).SetFocus

我修改了 紅色字體 , 變成LOT、回溫後使用期限修改 一個字元就跳去下一格, 回溫使用期限點兩下變成1899年...
可否將膠紙製造日, 到期日 不卡規則呢?? 因為也是刷條碼, 廠商條碼格式就像當初的一樣是字元格式 ”20171011” , 再由程式去轉換時間格式
  If T > 3 And T <> 6 And T <> UBound(Text_Ar) Then Text_Ar(T + 1).SetFocus

GBKEE

回復 19# v03586
回溫使用期限點兩下變成1899年...
修改這裡

1. Sub 放入冰箱()   'Input 冰箱 (資料存入『Database-冰箱』)
   
2.     Set Sh = Sheets("Database-冰箱")
   
3.     回溫後使用期限 = Now + 2       '**給值
   
4.     Com_Title = " [ 放入冰箱 ]"
   
5.     Form_InPut.Show
   
6. End Sub

複製代碼

1. If T = 3 Or T >= 6 And T <> UBound(Text_Ar) Then Text_Ar(T + 1).SetFocus
   
2.         '** 1工號 , 2層架編號 , 4LOT, 5PCS  **不設格式不跳到下一輸 入控制項
   
3.         '**3Film P/N , 6回溫後使用期限, 7膠紙製造日 8 膠紙到期日 **'跳到下一輸 入控制項
   
4.         '** 9 放入時間=>Text_Ar(T + 1).SetFocus 會有錯誤的

複製代碼

工號 跟 層架編號....   解除限制

1. Private Sub TextBox1_Change()          '** 控制項有變動 : 程式作用  資料格式 的檢查
   
2.      '**不限制格式
   
3.      TheMsg 1, Trim(TextBox1) <> ""   '不限制格式
   
4. End Sub

複製代碼

設定條碼格式

1. Private Sub TextBox7_Change()
   
2.     '格式  條碼 8 位數
   
3.     Dim St(1 To 2) As String, Msg As Boolean, Ar
   
4.     St(1) = Trim(TextBox7)
   
5.     Msg = Len(St(1)) = 8 And IsNumeric(St(1)): If Not Msg Then GoTo Ne
   
6.     St(2) = Mid(St(1), 1, 4) & "/" & Mid(St(1), 5, 2) & "/" & Mid(St(1), 7, 2)
   
7.     Msg = IsDate(St(2)): If Not Msg Then GoTo Ne         '**日期正確
   
8.     Msg = DateValue(St(2)) < Date: If Not Msg Then GoTo Ne    '**膠紙製造日必小於當日
   
9. Ne:
   
10.     TheMsg IIf(Label6.Enabled, 7, 6), Msg
    
11. End Sub
    
12. Private Sub TextBox8_Change()
    
13.      '格式  條碼 8 位數
    
14.     Dim St(1 To 3) As String, Msg As Boolean, Ar
    
15.    St(1) = Trim(TextBox8)
    
16.     Msg = Len(St(1)) = 8 And IsNumeric(St(1)): If Not Msg Then GoTo Ne
    
17.     St(2) = Mid(St(1), 1, 4) & "/" & Mid(St(1), 5, 2) & "/" & Mid(St(1), 7, 2)  '膠紙到期日
    
18.     Msg = IsDate(St(2)): If Not Msg Then GoTo Ne
    
19.     Msg = Text_Msg(IIf(Label6.Enabled, 7, 6)): If Not Msg Then GoTo Ne '膠紙製造日是否正確
    
20.     St(3) = Trim(TextBox7)
    
21.     St(3) = Mid(St(3), 1, 4) & "/" & Mid(St(3), 5, 2) & "/" & Mid(St(3), 7, 2)  '**'膠紙製造日
    
22.     Msg = DateValue(St(2)) > DateValue(St(3))                       '**膠紙到期日必大於膠紙製造日
    
23. Ne:
    
24.     TheMsg IIf(Label6.Enabled, 8, 7), Msg
    
25. End Sub
    
26. '**設定條碼格式 後需修改
    
27. Private Sub ComButton_Click()          '**控制項的事件 (按下控制項)
    
28.     Dim i As Integer, XR As Integer
    
29.     If MsgBox(Join(Text_Ar, vbLf), vbYesNo, "   ** 確定 " & Com_Title & "  **") = vbYes Then
    
30.         '**Join 函數 傳回一個字串 , 該字串是透過連結某個陣列中的多個子字串而建立的
    
31.         XR = Application.CountA(Sh.[A:A])
    
32.         With Sh.Range("A" & XR).Offset(1)
    
33.             For i = 1 To UBound(Text_Ar)               '**UBound 函數 傳回 Long值，表示指定陣列某維最大可使用的陣列索引。
    
34.                  If InStr(Sh.Name, "冰箱") And (i = 6 Or i = 7) Then
    
35.                     .Cells(1, i) = Mid(Text_Ar(i), 1, 4) & "/" & Mid(Text_Ar(i), 5, 2) & "/" & Mid(Text_Ar(i), 7, 2)
    
36.                  ElseIf InStr(Sh.Name, "冰箱") = 0 And (i = 7 Or i = 8) Then
    
37.                     .Cells(1, i) = Mid(Text_Ar(i), 1, 4) & "/" & Mid(Text_Ar(i), 5, 2) & "/" & Mid(Text_Ar(i), 7, 2)
    
38.                  Else
    
39.                     .Cells(1, i) = UCase(Text_Ar(i).Text)  '**UCase 函數 傳回一個 Variant (String)，所含為轉成大寫之字串。
    
40.                 End If
    
41.             Next
    
42.         End With
    
43.         DataBase_Show
    
44.     End If
    
45.     ListBox1_Change
    
46. End Sub

複製代碼