- 帖子
- 5923
- 主題
- 13
- 精華
- 1
- 積分
- 5986
- 點名
- 0
- 作業系統
- win10
- 軟體版本
- Office 2010
- 閱讀權限
- 150
- 性別
- 男
- 來自
- 台灣基隆
- 註冊時間
- 2010-5-1
- 最後登錄
- 2022-1-23
        
|
5#
發表於 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
在工作上寫上 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
|
|
發表於 2016-10-7 14:31
| 
