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

v03586

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

複製代碼

下載 (117.66 KB)

2016-10-7 14:31

Film WIP Management.rar (768.26 KB)

下載次數: 8

2016-10-7 14:31

v03586

回復 1# v03586


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

下載 (125.67 KB)

2016-10-9 15:39

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

下載 (66.76 KB)

2016-10-9 15:39

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

下載 (22.42 KB)

2016-10-9 16:02

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

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

下載 (13.42 KB)

2016-10-9 15:56

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

如下是修改後的檔案
Film WIP Management_v1.rar (1005.66 KB)

下載次數: 6

2016-10-9 16:06

GBKEE

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

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

膠紙製造日,膠紙到期日 的資料格式為何用文字而不用日期格式.
距離過期天數: DATE-膠紙到期日 ,排序可用 [膠紙到期日]欄 遞增

v03586

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

GBKEE

回復 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.         
    
28.         St = "距離過期天數"
    
29.         i(2) = Application.WorksheetFunction.Match(St, Rows(1), 0) '**傳回距離過期天數的欄位
    
30.      
    
31.         With .Columns(i(2)).Range("a2:a" & .Range("a" & Rows.Count).End(xlUp).Row)  '
    
32.         i(3) = i(2) - i(1)
    
33.             
    
34.              '.FormulaR1C1 = "=IF(ISNUMBER(RC[-2]),RC[-2]-TODAY(), """")"
    
35.              .FormulaR1C1 = "=IF(ISNUMBER(RC[-" & i(3) & "]),RC[-" & i(3) & "]-TODAY(), """")"
    
36.             
    
37.              '**'距離過期天數的欄位寫上公式
    
38.             
    
39.             .NumberFormatLocal = "G/通用格式"
    
40.             .Value = .Value    '**公式轉為值
    
41.             Set D = CreateObject("scripting.dictionary") '**字典物件
    
42.             For Each e In .Cells
    
43.                 If e <> "" Then            '有值的儲存格
    
44.                     D(e.Value) = ""        ' e.Value 為字典物件的key
    
45.                     If Rng Is Nothing Then
    
46.                         Set Rng = e
    
47.                     Else
    
48.                         Set Rng = Union(Rng, e)  'Union 方法   傳回兩個或多個範圍的合併範圍。
    
49.                     End If
    
50.                 End If
    
51.             Next
    
52.             For Each e In Rng
    
53.                 For i(1) = 1 To D.Count
    
54.                     If e = Application.Small(D.keys, i(1)) Then
    
55.                         'e為字典物件key值的第幾 [i(1)] 小的值
    
56.                         e.Offset(, 1) = i(1)   '優先拿取順序
    
57.                         Exit For
    
58.                     End If
    
59.                 Next
    
60.             Next
    
61.         End With
    
62.    End With
    
63.    
    
64.     '排序
    
65.     'Q1-1. 輸入放入冰箱功能, 請問是否可以輸入完資料後自動依照「C50」欄位主要排序, 再由「J50」欄位次要排序嗎??
    
66. 
    
67.    With Rng.EntireRow
    
68.         'Q2-1. 輸入回溫區功能, 請問是否可以輸入完資料後自動依照「C50」欄位主要排序, 再由「J50」欄位次要排序
    
69.        '**  key1:=.Cells(1, i(2)), Order1:=1 優先拿取順序為主排序鍵
    
70.         .Sort key2:=.Cells(1, "c"), Order1:=1, key1:=.Cells(1, i(2)), Order1:=1, header:=xlNo
    
71.         
    
72.         'Q5. 『取出回溫區』、『取出氮氣櫃』資料表的拿取順序是否會再次重新排序???
    
73.         ' **指裡  資料表內會重新排序
    
74.    End With
    
75. End Sub

複製代碼

v03586

回復 5# GBKEE


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

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

下載 (45.33 KB)

2016-10-12 04:34

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

GBKEE

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

複製代碼

v03586

回復 7# GBKEE


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

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

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

v03586

回復 7# GBKEE


    版大你好!!

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

下載 (40.1 KB)

2016-10-13 04:32

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

下載 (152.11 KB)

2016-10-13 04:49

Film WIP Management_v1.rar (1012.92 KB)

下載次數: 6

2016-10-13 04:50

v03586

回復 7# GBKEE


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

下載 (51.82 KB)

2016-10-14 12:50