返回列表 上一主題 發帖

[發問] 輸入資料比對資料表 轉換到別的資料表

[發問] 輸入資料比對資料表 轉換到別的資料表

我有設計一個盤點程式
目前入庫功能都寫好了
但是有些出庫功能比較特殊, 資料表資料轉去別的資料表
想請求大大幫忙
操作介面為『每日盤點』資料表
程式邏輯就是IN / OUT ,  皆是判斷 Lot , 只要Lot 符合就將整筆資料轉移過去
1. 當資料放入冰箱時, 資料會存在『Database-冰箱』資料表, 當取出冰箱時, 資料會跑到『Database-回溫區』資料表
    『Database-冰箱』資料表的那筆資料必須刪除, 然後跑去『Database-回溫區』資料表
     如果輸入的Lot當中在『Database-冰箱』資料表內, 沒有輸入的Lot , 就新增『Database-回溫區』資料表內 ( 意思是 從別的地方放入, 不是從冰箱放入 )
    目前Intput 都撰寫OK, 唯獨 我卡在怎麼刪除...我的程式碼如下, 請求大大指教我錯在哪裡

2. 功能2 , 在圖片中”取出回溫區”這個按鈕按下, 會去比對『Database-回溫區』資料表中的Lot
只要符合就將整筆資料刪除

3.功能3, 取出氮氣櫃一樣比對『Database-入氮氣櫃』資料表中的Lot資料, 只要符合就將資料轉移至『Database-出氮氣櫃』資料表中
  1. Sub OutFilm()
  2.    Dim PromptsC(1 To 1) As String
  3.    Dim PromptsE(1 To 1) As String
  4.    Dim Inputs(1 To 1) As String
  5.    Dim i As Integer
  6.    Dim j As Integer
  7.    Dim Lot_Rng As Range
  8.    Dim NotFound As Boolean
  9.    Const D = 4
  10.    PromptsC(1) = "膠紙LOT"
  11.    PromptsE(1) = "Film Lot"
  12.    For j = 1 To 1
  13.      Inputs(j) = ""
  14.    Next j
  15.    For j = 1 To 1
  16.     Do
  17.        Inputs(j) = InputBox("請掃描" & PromptsC(j) & "[Please Scan " & PromptsE(j) & "]", _
  18.                             "請掃描" & PromptsC(j) & "[Please Scan " & PromptsE(j) & "]", "")
  19.        If Len(Inputs(j)) < 1 Then
  20.            If MsgBox("你的輸入有誤,是否重新輸入" & PromptsC(j) & "?" & vbCrLf & _
  21.                      "點擊""是""重新輸入,""否""退出當次輸入。" & vbCrLf & _
  22.                      "You are not enter " & PromptsE(j) & " ,Click ""是(Y)""Re-enter or ""否(N)""End enter", _
  23.                      vbYesNo Or vbQuestion, _
  24.                      "無輸入" & PromptsC(j) & " [You are not enter " & PromptsE(j) & "]") = vbNo Then Exit Sub
  25.        End If
  26.     Loop While Inputs(j) = ""
  27.    Next j
  28.    i = 2
  29.    NotFound = True
  30.    Do
  31.       If Inputs(1) = Worksheets("Database-冰箱").Cells(i, D) Then
  32.          Set Lot_Rng = Worksheets("Database-冰箱").Cells(i, D)
  33.          Worksheets("Database-冰箱").Rows(Inputs(1)).Delete
  34.          NotFound = False
  35.          Exit Do
  36.       End If
  37.       i = i + 1
  38.    Loop While Worksheets("Database-冰箱").Cells(i, A) <> ""
  39.    If NotFound Then MsgBox "找不到資料 < Can't not found data>"
  40. End Sub
複製代碼

Film WIP Management.rar (768.26 KB)

回復 21# v03586

附檔試試看

Ex.zip (878.16 KB)
   

[條碼] 沒接觸過,如有問題,我不知.
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 20# GBKEE


    版大您好!! 昨天將系統上線後, 使用者Feedback 的意見, 他們提到希望只要輸入有效資料
   資料表上需計算有效資料僅有
          『冰箱-Database』 G欄位-膠紙到期日
          『回溫區-Database』 F欄位-回溫後使用期限
          『氮氣櫃-Database』 F欄位-回溫後使用期限
    故希望將無效資料刪除, 節省人員作業時間
   刪除後
    資料欄位如下圖, 如此一來 計算欄位就一致了!! 就不會像之前冰箱特別在某一欄, 其他兩個欄位不一樣
   
   

修改後的IN/OUT 畫面如下圖
取出的畫面, 使用者雖然再查詢頁面找到Lot , 但資料筆數太多了...昨天找了很久, 可否新增一個需要輸入P/N 再讓使用者按拿取的畫面
(使用者也是刷條碼)

放進去的畫面, 除了冰箱不輸入, 回溫後使用期限, 其他都要輸入回溫後使用期限
不同一點的是, 冰箱要輸入膠紙到期日, 其他的則不需要輸入膠紙到期日 ,
工號, 層架. Lot 不卡資料格式 ,
PCS僅支援  1~999 ,  先前改完判斷 輸入1個數字就會跳到下一格
膠紙到期日一樣是回溫區,與氮氣櫃需要輸入, 一樣是刷條碼方式, 20161010 程式解析

之前輸入回溫後使用期限, 時間格式, 輸入到分 , 就會跳到下一格, 是否能有解呢??

放入日期是否可以改成按下按鈕的同時自動帶入資料庫就行了

TOP

本帖最後由 GBKEE 於 2016-10-20 05:54 編輯

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 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

TOP

本帖最後由 GBKEE 於 2016-10-20 05:06 編輯

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

本帖最後由 v03586 於 2016-10-19 12:43 編輯

回復 16# GBKEE


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

TOP

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

本帖最後由 v03586 於 2016-10-19 07:33 編輯

回復 14# GBKEE


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

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

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

不限制格式
請問是這樣修改即可嗎???
  1. Private Sub TextBox4_Change()
  2.     Dim St As String, Msg As Boolean, I As Integer, Ar

  3.     Msg = St <> ""
  4. End Sub
複製代碼

TOP

回復 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
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

        靜思自在 : 話多不如話少,話少不如話好。
返回列表 上一主題