返回列表 上一主題 發帖

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

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

我有設計一個盤點程式
目前入庫功能都寫好了
但是有些出庫功能比較特殊, 資料表資料轉去別的資料表
想請求大大幫忙
操作介面為『每日盤點』資料表
程式邏輯就是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)

回復 1# v03586


    感謝GBKEE 板大的提醒, 順帶修正了其他錯誤

   另外如下有 5 個問題, 求解
  Q1. 放入冰箱後資料會存在『Database-冰箱』資料表
          可否幫麻加入計算「I」欄位的距離過期天數, 依照「G」欄位到期日計算
          再由“快過期的”在「J」欄位, 顯示優先拿取的順序
          Q1-1. 輸入放入冰箱功能, 請問是否可以輸入完資料後自動依照「C50」欄位主要排序, 再由「J50」欄位次要排序嗎??



  Q2. 放入回溫區後資料會存在『Database-回溫區』資料表
          可否幫麻加入計算「J」欄位的距離過期天數, 依照「F」欄位與距離目前日期計算
          再由“快過期的”在「K」欄位, 顯示優先拿取的順序
          Q2-1. 輸入回溫區功能, 請問是否可以輸入完資料後自動依照「C50」欄位主要排序, 再由「J50」欄位次要排序嗎??
          Q2-2. 輸入回溫區功能比較特別, 輸入LOT時, 可否從『Database-冰箱』資料表, 判斷
                      如果有輸入一樣的LOT, 則從『Database-冰箱』資料表將重覆資料刪除??
          Q2-3. 另外「F」欄位是否能內建格式YYYY/MM/DD HH:MM ??


Q3. 放入氮氣櫃後資料會存在『Database-入氮氣櫃』資料表
          可否幫麻加入計算「J」欄位的距離過期天數, 依照「F」欄位與距離目前日期計算
          再由“快過期的”在「K」欄位, 顯示優先拿取的順序
          Q2-1. 輸入氮氣櫃功能, 請問是否可以輸入完資料後自動依照「C50」欄位主要排序, 再由「J50」欄位次要排序嗎??
          Q2-2. 另外「F」欄位是否能內建格式YYYY/MM/DD HH:MM ??


Q4. 查詢先進先出功能
       使用者選擇要查詢的資料表”下拉式選單”, 輸入料號後,按下﹝查詢﹞按鈕,  Listbox 顯示該料號的『前三筆順序』『LOT』『層架位置』



Q5. 『取出回溫區』、『取出氮氣櫃』資料表的拿取順序是否會再次重新排序???
   EX: 原本程式判斷優先順位1 被拿走了 ( 資料也意味著消失了 ) , 那是否資料表內會再重新判斷產生順序呢??

如下是修改後的檔案

Film WIP Management_v1.rar (1005.66 KB)

TOP

本帖最後由 GBKEE 於 2016-10-10 10:50 編輯

回復 2# v03586
請問 氮氣必先入氮氣櫃, 其它物件必先入冰箱. 取出(氮氣,冰箱物件),是否都必先入入回溫區

你所需的程式為 1:冰箱                A:存物件(新增資料)                B:取物件入回溫區(資料轉移到回溫區)
                    2:氮氣櫃              A:存氮氣(新增資料)                B:取氮氣,入回溫區(資料轉移到回溫區)
                    3: 出回溫區(刪除資料)
以上程序可否有一 [工號],[層架編號],[Film P/N],[Lot],[回溫後使用期限],[膠紙製造日],[膠紙到期日]的資料表,
做為這些程式的選項整合,用表單(UserForm)來執行


膠紙製造日,膠紙到期日 的資料格式為何用文字而不用日期格式.
距離過期天數: DATE-膠紙到期日 ,排序可用 [膠紙到期日]欄 遞增
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 3# GBKEE


    1. 放入冰箱=(完整都未使用) , 拿出來一定會經過回溫區
    2. 回溫區取出去使用後, 一定會放入氮氣櫃
    3. 氮氣櫃會放入回溫區的情況只有氮氣櫃位置不夠(撇開這點不談) , 基本上流程 : 冰箱->回溫區 ; 回溫區->未使用完畢入氮氣櫃 ; 氮氣櫃->未使用完畢入氮氣櫃

所需的程式為
                     1:冰箱                A:存物件(新增資料)                B:取物件入回溫區(資料轉移到回溫區)
                    2:氮氣櫃             A:存氮氣(新增資料)                B:取氮氣櫃,(刪除資料)
                    3: 出回溫區(刪除資料)

-----------
以上程序可否有一 [工號],[層架編號],[Film P/N],[Lot],[回溫後使用期限],[膠紙製造日],[膠紙到期日]的資料表,
做為這些程式的選項整合,用表單(UserForm)來執行

-----------
ANS: 以上程序都有寫程式以input box表示迴圈, 考慮大量收料 [工號],[層架編號],[Film P/N],為固定格式, 接下來[Lot],後面都跑回圈
每個程式[冰箱][回溫區][氮氣櫃] 都有對應的儲存資料表, 因為不會使用UserForm跑回圈, 所以用input box來執行此程式...



膠紙製造日,膠紙到期日 的資料格式為何用文字而不用日期格式.
ANS: 這是刷物品上的條碼...沒想到是文字格式, 能否強制轉換呢?
Format([資料表!F50:G], "yyyy/mm/dd")

TOP

本帖最後由 GBKEE 於 2016-10-16 13:57 編輯

回復 4# v03586
' Q4.查詢先進先出功能 '使用者選擇要查詢的資料表”下拉式選單”, 輸入料號後,按下﹝查詢﹞按鈕,
       'Listbox 顯示該料號的『前三筆順序』『LOT』『層架位置』
附檔的查詢表單模組的程式
  1. Dim Sh As Worksheet
  2. Private Sub UserForm_Initialize()
  3.     ComboBox1.AddItem "冰箱"
  4.     ComboBox1.AddItem "回溫區"
  5.     ComboBox1.AddItem "氮氣櫃"
  6. End Sub
  7. Private Sub CommandButton1_Click()
  8.     Unload Me
  9. End Sub
  10. Private Sub ComboBox1_Change()
  11.     Dim E As Worksheet
  12.     If ComboBox1.ListIndex > -1 Then
  13.         Set Sh = Sheets("Database-" & ComboBox1)
  14.          '**如有錯誤改用下列程式碼 : 工作表名稱的差異
  15.         'For Each E In Sheets
  16.         '    If InStr(E.Name, ComboBox1) Then
  17.         '        Set Sh = E
  18.         '        Exit For
  19.         '    End If
  20.         'Next
  21.         Ex_Ans Sh    '呼叫程序 傳遞參數
  22.         If Trim(TextBox2) <> "" Then TextBox2_Change
  23.     End If
  24. End Sub
  25. Private Sub TextBox2_Change()
  26.     Dim i As Integer, D As Object, Ar
  27.     Set D = CreateObject("SCRIPTING.DICTIONARY")
  28.     If Trim(TextBox2) <> "" And ComboBox1.ListIndex > -1 Then
  29.         i = 2
  30.         '料號是 Film P/NF ? ->Sh.Cells(i, "C")
  31.         Do While Sh.Cells(i, "a") <> ""
  32.             If Len(Sh.Cells(i, "a")) > 1 And UCase(Sh.Cells(i, "C")) = UCase(Trim(TextBox2)) Then
  33.                 '**Len(Sh.Cells(i, "a")) > 1  因各工作表 前49筆資料 "-" 為何??
  34.                 If Not D.exists(Trim(TextBox2)) Then
  35.                     D(Trim(TextBox2)) = Array(Array(Sh.Cells(i, "B").Text, Sh.Cells(i, "C").Text, Sh.Cells(i, "D").Text))
  36.                 Else
  37.                     Ar = D(Trim(TextBox2))
  38.                     ReDim Preserve Ar(0 To UBound(Ar) + 1)
  39.                     Ar(UBound(Ar)) = Array(Sh.Cells(i, "B").Text, Sh.Cells(i, "C").Text, Sh.Cells(i, "D").Text)
  40.                      D(Trim(TextBox2)) = Ar
  41.                 End If
  42.             End If
  43.             i = i + 1
  44.         Loop
  45.         With TextBox1  '附檔的查詢表單是 TextBox 控制項
  46.             .Text = ""
  47.            .Multi= True
  48.             .Multi屬性 指定控制項是否接受並顯示多行文字。
  49.         End With
  50.           '*********'附檔如有是 ListBox1 控制項
  51.         'With ListBox1
  52.         '    .ColumnCount = 3
  53.         '    .ColumnWidths = "30,50,50"
  54.         '    .Clear
  55.         'End With
  56.         '*********************************
  57.         If D.Count > 0 And D.exists(Trim(TextBox2)) Then
  58.             'ReDim Ar(0)                               '**附檔如有是 ListBox1 控制項
  59.             For i = 0 To UBound(D(Trim(TextBox2)))
  60.             '    ReDim Preserve Ar(0 To i)      '**'附檔如有是 ListBox1 控制項
  61.                 TextBox1 = TextBox1 & IIf(TextBox1 <> "", vbCrLf, "") & Join(D(Trim(TextBox2))(i), ",")
  62.             '    Ar(i) = D(Trim(TextBox2))(i)  '''附檔如有是 ListBox1 控制項
  63.                 If i = 2 Then Exit For  '顯示三筆
  64.             Next
  65.             '********'''附檔如有是 ListBox1 控制項
  66.             'If UBound(Ar) > 0 Then
  67.             '    ListBox1.List = Application.Transpose(Application.Transpose(Ar)) ''附檔如有是 ListBox1 控制項
  68.             'Else
  69.             '    Ar = Ar(0)
  70.             '    With ListBox1
  71.             '        .AddItem
  72.             '        For i = 0 To UBound(Ar)
  73.             '            .List(.ListCount - 1, i) = Ar(i)
  74.             '        Next
  75.             '    End With
  76.             'End If
  77.         End If
  78.     End If
  79. End Sub
複製代碼
Q2-3. 另外「F」欄位是否能內建格式YYYY/MM/DD HH:MM ??
  在工作上寫上 Now 會自動生成YYYY/MM/DD HH:MM 的格式

這程式碼請至於一般模組,可供其它程式使用
  1. Option Explicit
  2. Sub Ex_Ans(Sh As Worksheet)
  3.     Dim St As String, i(1 To 3) As Integer, D As Object, e As Variant, Rng As Range
  4.     'Set Sh = 查詢.Sh
  5.     With Sh
  6.     'With ActiveSheet   ' 可指定為『Database-冰箱』或『Database-回溫區』或『Database-入氮氣櫃』
  7.     '.Activate
  8.         St = "膠紙到期日"
  9.         i(1) = Application.WorksheetFunction.Match(St, Rows(1), 0) '**傳回膠紙到期日的欄位
  10.         
  11.         
  12.                 .Columns(i(1)).TextToColumns Destination:=.Cells(1, i(1)), DataType:=xlDelimited, _
  13.         FieldInfo:=Array(1, 5), TrailingMinusNumbers:=True  '***(文字格式, 轉換為日期)
  14.         
  15.         '   Q1. 放入冰箱後資料會存在『Database-冰箱』資料表
  16.         '       可否幫麻加入計算「I」欄位的距離過期天數, 依照「G」欄位到期日計算
  17.         '        再由“快過期的”在「J」欄位, 顯示優先拿取的順序
  18.   
  19.         ' Q2. 放入回溫區後資料會存在『Database-回溫區』資料表
  20.         '  可否幫麻加入計算「J」欄位的距離過期天數, 依照「F」欄位與距離目前日期計算
  21.         '  再由“快過期的”在「K」欄位, 顯示優先拿取的順序
  22.         
  23.         ' Q3. 放入氮氣櫃後資料會存在『Database-入氮氣櫃』資料表
  24.         '  可否幫麻加入計算「J」欄位的距離過期天數, 依照「F」欄位與距離目前日期計算
  25.         '  再由“快過期的”在「K」欄位, 顯示優先拿取的順序

  26.         
  27.         St = "距離過期天數"
  28.         i(2) = Application.WorksheetFunction.Match(St, Rows(1), 0) '**傳回距離過期天數的欄位
  29.      
  30.         With .Columns(i(2)).Range("a2:a" & .Range("a" & Rows.Count).End(xlUp).Row)  '
  31.         i(3) = i(2) - i(1)
  32.             
  33.              '.FormulaR1C1 = "=IF(ISNUMBER(RC[-2]),RC[-2]-TODAY(), """")"
  34.              .FormulaR1C1 = "=IF(ISNUMBER(RC[-" & i(3) & "]),RC[-" & i(3) & "]-TODAY(), """")"
  35.             
  36.              '**'距離過期天數的欄位寫上公式
  37.             
  38.             .NumberFormatLocal = "G/通用格式"
  39.             .Value = .Value    '**公式轉為值
  40.             Set D = CreateObject("scripting.dictionary") '**字典物件
  41.             For Each e In .Cells
  42.                 If e <> "" Then            '有值的儲存格
  43.                     D(e.Value) = ""        ' e.Value 為字典物件的key
  44.                     If Rng Is Nothing Then
  45.                         Set Rng = e
  46.                     Else
  47.                         Set Rng = Union(Rng, e)  'Union 方法   傳回兩個或多個範圍的合併範圍。
  48.                     End If
  49.                 End If
  50.             Next
  51.             For Each e In Rng
  52.                 For i(1) = 1 To D.Count
  53.                     If e = Application.Small(D.keys, i(1)) Then
  54.                         'e為字典物件key值的第幾 [i(1)] 小的值
  55.                         e.Offset(, 1) = i(1)   '優先拿取順序
  56.                         Exit For
  57.                     End If
  58.                 Next
  59.             Next
  60.         End With
  61.    End With
  62.    
  63.     '排序
  64.     'Q1-1. 輸入放入冰箱功能, 請問是否可以輸入完資料後自動依照「C50」欄位主要排序, 再由「J50」欄位次要排序嗎??

  65.    With Rng.EntireRow
  66.         'Q2-1. 輸入回溫區功能, 請問是否可以輸入完資料後自動依照「C50」欄位主要排序, 再由「J50」欄位次要排序
  67.        '**  key1:=.Cells(1, i(2)), Order1:=1 優先拿取順序為主排序鍵
  68.         .Sort key2:=.Cells(1, "c"), Order1:=1, key1:=.Cells(1, i(2)), Order1:=1, header:=xlNo
  69.         
  70.         'Q5. 『取出回溫區』、『取出氮氣櫃』資料表的拿取順序是否會再次重新排序???
  71.         ' **指裡  資料表內會重新排序
  72.    End With
  73. End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

回復 5# GBKEE


      料號是 Film P/N ?
       YES
    因各工作表 前49筆資料 "-" 為何??
   其實是N/A值 , 沒有LOT只是為了怕盤點, 資料與實際數量有誤差, 可以在PCS欄位偷偷調帳用! 所預設的伏筆!!

1. 附檔的查詢表單模組的程式
貼入後出現如下錯誤, 任何選擇項目都會跳出錯誤


2.這程式碼請至於一般模組,可供其它程式使用
請問這是放在Module1 裡面嗎? 還是要拆去各個分頁內的程式碼中呢??

TOP

本帖最後由 GBKEE 於 2016-10-12 07:41 編輯

回復 6# v03586

5# 查詢表單模組的程式碼有更新

Sub Ex_Ans(Sh As Worksheet) 放在Module1 (一般模組) 沒錯的

i(1) = Application.WorksheetFunction.Match(St, Rows(1), 0) '**傳回膠紙到期日的欄位
在2003版沒有錯誤的
請改用試試看  i(1) = Sh.Rows(1).Find(St, LookIn:=xlValues, LookAt:=xlWhole).Column '**傳回膠紙到期日的欄位

Q2-2. 輸入回溫區功能比較特別, 輸入LOT時, 可否從『Database-冰箱』資料表, 判斷
                      如果有輸入一樣的LOT, 則從『Database-冰箱』資料表將重覆資料刪除??
  1. Sub 取出回溫區()
  2.    Dim Rng As Range
  3.    '以上程式碼簡略
  4.    ''Inputs(j) = InputBox(" 您現在將要把膠紙從『 回溫區取出 』 " & vbCrLf
  5.    '以上程式碼簡略
  6.    'i = 2
  7.    'NotFound = True
  8.      '  Do
  9.     '    If Inputs(1) = Worksheets("Database-冰箱").Cells(i, "D") Then
  10.     '    *********'『 回溫區取出 』 是在 回溫區 而不是 冰箱  !!!  *****
  11.    
  12.     '        Set Lot_Rng = Worksheets("Database-冰箱").Cells(i, "D")
  13.     '        Worksheets("Database-冰箱").Rows(i).Delete
  14.     '        NotFound = False
  15.     '       Exit Do
  16.     '     End If
  17.     '     i = i + 1
  18.     '  Loop While Worksheets("Database-冰箱").Cells(i, "A") <> ""
  19.    
  20.    '    *********'『 回溫區取出 』 是在 回溫區 而不是 冰箱  !!!  *****
  21.    'Set Rng = Worksheets("Database-冰箱").Range("d:d").Find(Inputs(1), LookIn:=xlValues, LookAt:=xlWhole)
  22.    Set Rng = Worksheets("Database-回溫區").Range("d:d").Find(Inputs(1), LookIn:=xlValues, LookAt:=xlWhole)
  23.    If Not Rng Is Nothing Then
  24.         Rng.EntireRow.Delete
  25.         
  26.         'Q2-2. 輸入回溫區功能比較特別, 輸入LOT時, 可否從『Database-冰箱』資料表, 判斷
  27.         '              如果有輸入一樣的LOT, 則從『Database-冰箱』資料表將重覆資料刪除??
  28.         Set Rng = Worksheets("Database-冰箱").Range("d:d").Find(Inputs(1), LookIn:=xlValues, LookAt:=xlWhole)
  29.         If Not Rng Is Nothing Then Rng.EntireRow.Delete
  30.         
  31.    Else
  32.        MsgBox "找不到資料 < Can't not found data>"
  33.     End If
  34.     End Sub
複製代碼
感恩的心......(在麻辣家族討論區.用心學習會有進步的)
但資源無限,後援有限,  一天1元的贊助,人人有能力.

TOP

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

回復 7# GBKEE


    Sorry , 板大...我有點被搞亂了, 不知道怎麼貼上去程式內了....
    我設計的邏輯是
Input → 冰箱(存在『Database-冰箱』資料表) , Output 冰箱 會直接跑去回溫區(『Database-回溫區』)的 Input
                                                          ( Lot 是身分證 , 所以不會有重覆情況發生 , 如果有重覆也一併刪除 )
Input  → 回溫區 ( 會回到回溫區等於氮氣櫃沒位置放了, 才會放到這 ) ,Output 回溫區 會直接把資料刪除 , 等於拿出去給機器用了
Input  → 氮氣櫃 ( 機台上用不完放回去這邊 ) ,Output 氮氣櫃 會直接把資料刪除 , 等於拿出去給機器用了


冰箱取出=直接入回溫區(input) , 會再多設一個 回溫區input 是因為怕位置不夠放 , 暫放回溫區 , 才設一個回溫區 Input
回溫區取出=把東西拿出去用 僅將資料刪除 , 併重新排序 『取出優先順序(先進先出)』
氮氣櫃取出=把東西拿出去用 僅將資料刪除 , 併重新排序 『取出優先順序(先進先出)』

放入(新增)與取出(刪除) 都要排序先進先出 ( 資料表中的 < 取出優先順序 > 讓使用者知道第一個要拿取的LOT是什麼

TOP

[版主管理留言]
  • GBKEE(2016/10/16 14:07): 是網頁的問題 MultiLine 一直顯示為 Multi 我已更正三次 MultiLine 還是顯示為 Multi

回復 7# GBKEE


    版大你好!!

    更改了 查詢的功能後 ,點選查詢功能, 輸入完料號(Film P/N) , 出現如下的錯誤訊息 ,
   

    另外取出回溫區是將資料刪除 = 拿出去使用 , 並非重冰箱的資料庫刪除 , 我利用圖文再次說明一下
   其邏輯跟#8樓敘述一樣
  


Film WIP Management_v1.rar (1012.92 KB)

TOP

回復 7# GBKEE


    最近再測...不管放入或取出 , 資料優先拿取順序不會在新增, 且距離過期日也不會計算
    不知道哪邊出了問題, 可否協助檢察哪邊錯了呢??

TOP

        靜思自在 : 站在半路,比走到目標更辛苦。
返回列表 上一主題