麻辣家族討論版版 - Powered by Discuz! Board

標題: [發問] 輸入資料比對資料表轉換到別的資料表 [打印本頁]

作者: v03586 時間: 2016-10-7 14:31 標題: 輸入資料比對資料表轉換到別的資料表

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

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

3.功能3, 取出氮氣櫃一樣比對『Database-入氮氣櫃』資料表中的Lot資料, 只要符合就將資料轉移至『Database-出氮氣櫃』資料表中

Sub OutFilm()
Dim PromptsC(1 To 1) As String
Dim PromptsE(1 To 1) As String
Dim Inputs(1 To 1) As String
Dim i As Integer
Dim j As Integer
Dim Lot_Rng As Range
Dim NotFound As Boolean
Const D = 4
PromptsC(1) = "膠紙LOT"
PromptsE(1) = "Film Lot"
For j = 1 To 1
Inputs(j) = ""
Next j
For j = 1 To 1
Do
Inputs(j) = InputBox("請掃描" & PromptsC(j) & "[Please Scan " & PromptsE(j) & "]", _
"請掃描" & PromptsC(j) & "[Please Scan " & PromptsE(j) & "]", "")
If Len(Inputs(j)) < 1 Then
If MsgBox("你的輸入有誤，是否重新輸入" & PromptsC(j) & "?" & vbCrLf & _
"點擊""是""重新輸入，""否""退出當次輸入。" & vbCrLf & _
"You are not enter " & PromptsE(j) & " ,Click ""是(Y)""Re-enter or ""否(N)""End enter", _
vbYesNo Or vbQuestion, _
"無輸入" & PromptsC(j) & " [You are not enter " & PromptsE(j) & "]") = vbNo Then Exit Sub
End If
Loop While Inputs(j) = ""
Next j
i = 2
NotFound = True
Do
If Inputs(1) = Worksheets("Database-冰箱").Cells(i, D) Then
Set Lot_Rng = Worksheets("Database-冰箱").Cells(i, D)
Worksheets("Database-冰箱").Rows(Inputs(1)).Delete
NotFound = False
Exit Do
End If
i = i + 1
Loop While Worksheets("Database-冰箱").Cells(i, A) <> ""
If NotFound Then MsgBox "找不到資料 < Can't not found data>"
End Sub

複製代碼

[attach]25475[/attach]
[attach]25474[/attach]

作者: v03586 時間: 2016-10-9 16:06

回復 1# v03586

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

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

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

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

如下是修改後的檔案
[attach]25506[/attach]

作者: GBKEE 時間: 2016-10-10 09:31

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

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

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

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

作者: v03586 時間: 2016-10-10 13:30

回復 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 時間: 2016-10-11 20:48

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

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

Dim Sh As Worksheet
Private Sub UserForm_Initialize()
ComboBox1.AddItem "冰箱"
ComboBox1.AddItem "回溫區"
ComboBox1.AddItem "氮氣櫃"
End Sub
Private Sub CommandButton1_Click()
Unload Me
End Sub
Private Sub ComboBox1_Change()
Dim E As Worksheet
If ComboBox1.ListIndex > -1 Then
Set Sh = Sheets("Database-" & ComboBox1)
'**如有錯誤改用下列程式碼 : 工作表名稱的差異
'For Each E In Sheets
' If InStr(E.Name, ComboBox1) Then
' Set Sh = E
' Exit For
' End If
'Next
Ex_Ans Sh '呼叫程序傳遞參數
If Trim(TextBox2) <> "" Then TextBox2_Change
End If
End Sub
Private Sub TextBox2_Change()
Dim i As Integer, D As Object, Ar
Set D = CreateObject("SCRIPTING.DICTIONARY")
If Trim(TextBox2) <> "" And ComboBox1.ListIndex > -1 Then
i = 2
'料號是 Film P/NF ? ->Sh.Cells(i, "C")
Do While Sh.Cells(i, "a") <> ""
If Len(Sh.Cells(i, "a")) > 1 And UCase(Sh.Cells(i, "C")) = UCase(Trim(TextBox2)) Then
'**Len(Sh.Cells(i, "a")) > 1 因各工作表前49筆資料 "-" 為何??
If Not D.exists(Trim(TextBox2)) Then
D(Trim(TextBox2)) = Array(Array(Sh.Cells(i, "B").Text, Sh.Cells(i, "C").Text, Sh.Cells(i, "D").Text))
Else
Ar = D(Trim(TextBox2))
ReDim Preserve Ar(0 To UBound(Ar) + 1)
Ar(UBound(Ar)) = Array(Sh.Cells(i, "B").Text, Sh.Cells(i, "C").Text, Sh.Cells(i, "D").Text)
D(Trim(TextBox2)) = Ar
End If
End If
i = i + 1
Loop
With TextBox1 '附檔的查詢表單是 TextBox 控制項
.Text = ""
.Multi= True
.Multi屬性指定控制項是否接受並顯示多行文字。
End With
'*********'附檔如有是 ListBox1 控制項
'With ListBox1
' .ColumnCount = 3
' .ColumnWidths = "30,50,50"
' .Clear
'End With
'*********************************
If D.Count > 0 And D.exists(Trim(TextBox2)) Then
'ReDim Ar(0) '**附檔如有是 ListBox1 控制項
For i = 0 To UBound(D(Trim(TextBox2)))
' ReDim Preserve Ar(0 To i) '**'附檔如有是 ListBox1 控制項
TextBox1 = TextBox1 & IIf(TextBox1 <> "", vbCrLf, "") & Join(D(Trim(TextBox2))(i), ",")
' Ar(i) = D(Trim(TextBox2))(i) '''附檔如有是 ListBox1 控制項
If i = 2 Then Exit For '顯示三筆
Next
'********'''附檔如有是 ListBox1 控制項
'If UBound(Ar) > 0 Then
' ListBox1.List = Application.Transpose(Application.Transpose(Ar)) ''附檔如有是 ListBox1 控制項
'Else
' Ar = Ar(0)
' With ListBox1
' .AddItem
' For i = 0 To UBound(Ar)
' .List(.ListCount - 1, i) = Ar(i)
' Next
' End With
'End If
End If
End If
End Sub

複製代碼

Q2-3. 另外「F」欄位是否能內建格式YYYY/MM/DD HH:MM ??
在工作上寫上 Now 會自動生成YYYY/MM/DD HH:MM 的格式

這程式碼請至於一般模組,可供其它程式使用

Option Explicit
Sub Ex_Ans(Sh As Worksheet)
Dim St As String, i(1 To 3) As Integer, D As Object, e As Variant, Rng As Range
'Set Sh = 查詢.Sh
With Sh
'With ActiveSheet ' 可指定為『Database-冰箱』或『Database-回溫區』或『Database-入氮氣櫃』
'.Activate
St = "膠紙到期日"
i(1) = Application.WorksheetFunction.Match(St, Rows(1), 0) '**傳回膠紙到期日的欄位
.Columns(i(1)).TextToColumns Destination:=.Cells(1, i(1)), DataType:=xlDelimited, _
FieldInfo:=Array(1, 5), TrailingMinusNumbers:=True '***(文字格式, 轉換為日期)
' Q1. 放入冰箱後資料會存在『Database-冰箱』資料表
' 可否幫麻加入計算「I」欄位的距離過期天數, 依照「G」欄位到期日計算
' 再由“快過期的”在「J」欄位, 顯示優先拿取的順序
' Q2. 放入回溫區後資料會存在『Database-回溫區』資料表
' 可否幫麻加入計算「J」欄位的距離過期天數, 依照「F」欄位與距離目前日期計算
' 再由“快過期的”在「K」欄位, 顯示優先拿取的順序
' Q3. 放入氮氣櫃後資料會存在『Database-入氮氣櫃』資料表
' 可否幫麻加入計算「J」欄位的距離過期天數, 依照「F」欄位與距離目前日期計算
' 再由“快過期的”在「K」欄位, 顯示優先拿取的順序
St = "距離過期天數"
i(2) = Application.WorksheetFunction.Match(St, Rows(1), 0) '**傳回距離過期天數的欄位
With .Columns(i(2)).Range("a2:a" & .Range("a" & Rows.Count).End(xlUp).Row) '
i(3) = i(2) - i(1)
'.FormulaR1C1 = "=IF(ISNUMBER(RC[-2]),RC[-2]-TODAY(), """")"
.FormulaR1C1 = "=IF(ISNUMBER(RC[-" & i(3) & "]),RC[-" & i(3) & "]-TODAY(), """")"
'**'距離過期天數的欄位寫上公式
.NumberFormatLocal = "G/通用格式"
.Value = .Value '**公式轉為值
Set D = CreateObject("scripting.dictionary") '**字典物件
For Each e In .Cells
If e <> "" Then '有值的儲存格
D(e.Value) = "" ' e.Value 為字典物件的key
If Rng Is Nothing Then
Set Rng = e
Else
Set Rng = Union(Rng, e) 'Union 方法傳回兩個或多個範圍的合併範圍。
End If
End If
Next
For Each e In Rng
For i(1) = 1 To D.Count
If e = Application.Small(D.keys, i(1)) Then
'e為字典物件key值的第幾 [i(1)] 小的值
e.Offset(, 1) = i(1) '優先拿取順序
Exit For
End If
Next
Next
End With
End With
'排序
'Q1-1. 輸入放入冰箱功能, 請問是否可以輸入完資料後自動依照「C50」欄位主要排序, 再由「J50」欄位次要排序嗎??
With Rng.EntireRow
'Q2-1. 輸入回溫區功能, 請問是否可以輸入完資料後自動依照「C50」欄位主要排序, 再由「J50」欄位次要排序
'** key1:=.Cells(1, i(2)), Order1:=1 優先拿取順序為主排序鍵
.Sort key2:=.Cells(1, "c"), Order1:=1, key1:=.Cells(1, i(2)), Order1:=1, header:=xlNo
'Q5. 『取出回溫區』、『取出氮氣櫃』資料表的拿取順序是否會再次重新排序???
' **指裡資料表內會重新排序
End With
End Sub

複製代碼

作者: v03586 時間: 2016-10-12 04:35

回復 5# GBKEE

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

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

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

作者: GBKEE 時間: 2016-10-12 06:16

本帖最後由 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-冰箱』資料表將重覆資料刪除??

Sub 取出回溫區()
Dim Rng As Range
'以上程式碼簡略
''Inputs(j) = InputBox(" 您現在將要把膠紙從『回溫區取出』 " & vbCrLf
'以上程式碼簡略
'i = 2
'NotFound = True
' Do
' If Inputs(1) = Worksheets("Database-冰箱").Cells(i, "D") Then
' *********'『回溫區取出』是在回溫區而不是冰箱 !!! *****
' Set Lot_Rng = Worksheets("Database-冰箱").Cells(i, "D")
' Worksheets("Database-冰箱").Rows(i).Delete
' NotFound = False
' Exit Do
' End If
' i = i + 1
' Loop While Worksheets("Database-冰箱").Cells(i, "A") <> ""
' *********'『回溫區取出』是在回溫區而不是冰箱 !!! *****
'Set Rng = Worksheets("Database-冰箱").Range("d:d").Find(Inputs(1), LookIn:=xlValues, LookAt:=xlWhole)
Set Rng = Worksheets("Database-回溫區").Range("d:d").Find(Inputs(1), LookIn:=xlValues, LookAt:=xlWhole)
If Not Rng Is Nothing Then
Rng.EntireRow.Delete
'Q2-2. 輸入回溫區功能比較特別, 輸入LOT時, 可否從『Database-冰箱』資料表, 判斷
' 如果有輸入一樣的LOT, 則從『Database-冰箱』資料表將重覆資料刪除??
Set Rng = Worksheets("Database-冰箱").Range("d:d").Find(Inputs(1), LookIn:=xlValues, LookAt:=xlWhole)
If Not Rng Is Nothing Then Rng.EntireRow.Delete
Else
MsgBox "找不到資料 < Can't not found data>"
End If
End Sub

複製代碼

作者: v03586 時間: 2016-10-12 12:32

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

回復 7# GBKEE

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

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

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

作者: v03586 時間: 2016-10-13 04:51

回復 7# GBKEE

版大你好!!

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

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

[attach]25531[/attach]

作者: v03586 時間: 2016-10-14 12:50

回復 7# GBKEE

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

作者: v03586 時間: 2016-10-16 02:46

本帖最後由 v03586 於 2016-10-16 02:51 編輯

回復 7# GBKEE

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

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

最後一個功能可有可無....就是『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

[attach]25553[/attach]

作者: GBKEE 時間: 2016-10-16 14:00

本帖最後由 GBKEE 於 2016-10-17 07:22 編輯

回復 11# v03586

附檔看看有意見再提出

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

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

複製代碼

方法一

If D.Count > 0 And D.exists(Trim(TextBox2)) Then
If UBound(D(Trim(TextBox2))) = 0 Then
Ar = D(Trim(TextBox2))(0)
With ListBox1
.AddItem
For i = 0 To UBound(Ar)
.List(.ListCount - 1, i) = Ar(i)
Next
End With
Else
ReDim Ar(0 To 2)
For i = 0 To UBound(D(Trim(TextBox2)))
Ar(i) = D(Trim(TextBox2))(i) '''附檔如有是 ListBox1 控制項
If i = 2 Then Exit For '顯示三筆
Next
ListBox1.List = Application.Transpose(Application.Transpose(Ar)) ''附檔如有是 ListBox1 控制項
End If
End If

複製代碼

方法二

If D.Count > 0 And D.exists(Trim(TextBox2)) Then
'ReDim Ar(0 To UBound(D(Trim(TextBox2))))
If UBound(D(Trim(TextBox2))) = 0 Then
'Ar = D(Trim(TextBox2))
With Range("A" & Rows.Count).Resize(, UBound(D(Trim(TextBox2))(0)) + 1)
.Value = D(Trim(TextBox2))(0)
ListBox1.List = .Value
.Cells.Clear
End With
Else
ReDim Ar(0 To 2)
For i = 0 To UBound(D(Trim(TextBox2)))
Ar(i) = D(Trim(TextBox2))(i) '''附檔如有是 ListBox1 控制項
If i = 2 Then Exit For '顯示三筆
Next
ListBox1.List = Application.Transpose(Application.Transpose(Ar)) ''附檔如有是 ListBox1 控制項
End If
End If

複製代碼

作者: v03586 時間: 2016-10-19 03:27

本帖最後由 v03586 於 2016-10-19 03:32 編輯

回復 12# GBKEE

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

2. 計算過期規則不一樣
如下圖 , 冰箱的計算過期方式是由 G欄位”膠紙到期日”去判斷距離現在還有多少天到期 ( 冰箱功能沒問題 )
[attach]25574[/attach]
但是, 下圖回溫區與氮氣櫃的計算方式不同, 是由F欄位『回溫後使用期限』,判斷距離現在還有多少天到期(回溫區, 與氮氣櫃錯誤)
冰箱資料表、回溫區資料表、氮氣櫃資料表三張資料表格式僅差一欄『回溫後使用期限』
[attach]25575[/attach]

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

部分查詢料號會無法帶出資料 , 如下圖
[attach]25577[/attach]

作者: GBKEE 時間: 2016-10-19 06:56

回復 13# v03586

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

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

複製代碼

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

Private Sub ComboBox2_Change()
Dim Rng As Range, Ar, I As Integer
With ListBox1
.Clear
If ComboBox2.ListIndex = -1 Then Exit Sub
Ar = Dt(ComboBox2.Value)
If UBound(Ar) = 0 Then
.AddItem
For I = 0 To UBound(Ar(0))
.List(0, I) = Ar(0)(I)
Next
Else
.List = Application.Transpose(Application.Transpose(Ar))
End If
End With
End Sub

複製代碼

作者: v03586 時間: 2016-10-19 07:19

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

回復 14# GBKEE

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

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

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

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

Private Sub TextBox4_Change()
Dim St As String, Msg As Boolean, I As Integer, Ar
Msg = St <> ""
End Sub

複製代碼

作者: GBKEE 時間: 2016-10-19 08:51

回復 15# v03586

Private Sub TextBox4_Change()
Dim St As String, Msg As Boolean
St = Trim(TextBox4)
Msg = St <> ""
TheMsg 4, Msg
End Sub

複製代碼

Private Sub Lot_Get()
Dim I As Long, St As String, B As String, C As String, d As String, Ar(), X As Integer
Set Dt = CreateObject("ScripTING.DICTIONARY")
'X = IIf(InStr(ActiveSheet.Name, "冰箱"), 9, 10)
With Sh
X = IIf(InStr(.Name, "冰箱"), 9, 10)
I = ShRow
Do While .Cells(I, "C") <> ""
B = .Cells(I, "B"): C = .Cells(I, "C"): d = .Cells(I, "D"): St = Format(.Cells(I, X), "0.0")
If Not Dt.EXISTS(C) Then
Dt(C) = Array(Array(B, C, d, St))
Else
Ar = Dt(C)
ReDim Preserve Ar(LBound(Ar) To UBound(Ar) + 1)
Ar(UBound(Ar)) = Array(B, C, d, St)
Dt(C) = Ar
Ar = Dt(C)
End If
I = I + 1
Loop
End With

複製代碼

作者: v03586 時間: 2016-10-19 12:42

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

回復 16# GBKEE

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

[attach]25579[/attach]

作者: GBKEE 時間: 2016-10-19 12:47

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

回復 17# v03586

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

複製代碼

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

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

複製代碼

作者: v03586 時間: 2016-10-19 13:27

回復 18# GBKEE

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

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

複製代碼

層架編號

Private Sub TextBox2_Change()
Dim St As String, Msg As Boolean
St = Trim(TextBox2)
Msg = St <> ""
TheMsg 2, Msg
End Sub

複製代碼

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

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

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

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

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

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

複製代碼

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

複製代碼

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

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

複製代碼

設定條碼格式

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

複製代碼

作者: v03586 時間: 2016-10-21 13:29

回復 20# GBKEE

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

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

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

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

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

作者: GBKEE 時間: 2016-10-23 10:38

回復 21# v03586

附檔試試看

[attach]25602[/attach]

[條碼] 沒接觸過,如有問題,我不知.

歡迎光臨麻辣家族討論版版 (http://forum.twbts.com/)