Set d = CreateObject("Scripting.Dictionary") '賦值D為字典對象
arr = Sheet1.UsedRange
For i = 2 To UBound(arr)
If arr(i, 1) <> "" Then d(arr(i, 1)) = "" 'D增加關鍵字
Next
With Range("B2").Validation
.Delete
.Add 3, 1, 1, Join(d.keys, ",") 'B2增加數據有效性等於D關鍵字相連的值
End With
Set d = Nothing
End Sub
Sub 查詢()
Dim d, arr, brr(), ar, br(), abr(), m, n, i, j, a, b, aa, s
Range("A5:P10000").ClearContents '清除("A5:P10000")單元格區域內容
If Range("B2") = "" Then MsgBox "請選擇料號！程序退出。", 64, "溫馨提示": Exit Sub
If Range("C2") = "" Then MsgBox "請填寫出庫數量！程序退出。", 64, "溫馨提示": Exit Sub '單元格B2和C2單元格為空值時彈出對話框提示
arr = Sheet1.UsedRange '賦值ARR
For i = 2 To UBound(arr) '在ARR1維中循環
If arr(i, 1) = Range("B2") And arr(i, 4) = "Available" Then '判定單元格是否等於 Range("B2") 和arr(i, 4) = "Available"就執行下面的代碼
m = m + 1 'M值進行累加
ReDim Preserve brr(1 To 7, 1 To m) '給BRR數給賦值，
For j = 1 To 6 'J從壹到6循環
brr(j, m) = arr(i, j) '給BRR賦值等於對應的arr數組理面的值
Next
brr(7, m) = arr(i, 10) '同樣是是BRR賦值
End If
If arr(i, 1) = Range("B2") Then '判定arr(i, 1) = Range("B2")就執行下面代碼
s = s + 1 'S值進行累加
ReDim Preserve abr(1 To 7, 1 To s) 'M 同樣也是給abr賦值等於對應的arr數組理面的值
For j = 1 To 6
abr(j, s) = arr(i, j)
Next
abr(7, s) = arr(i, 10)
End If
Next
If m = 0 Then '判斷M等於0就執行下面的程序
Range("B5:H10000").ClearContents '清除(("B5:H10000")單元格區域內容
[B5].Resize(s, 7) = Application.Transpose(abr) '{B5]擴充區域後賦值等於abr轉置的值
Range("B5:H" & s + 4).Sort [H5] '對H列排序
MsgBox "" & Range("B2") & "料號可出庫的庫存是0！程序退出。", 64, "溫馨提示" '彈出提示
Exit Sub '退出程序
End If
[B5].Resize(m, 7) = Application.Transpose(brr) ' '{B5]擴充區域後賦值等於BRR轉置的值
Range("B5:H" & m + 4).Sort [H5] '對H列排序
arr = Range("B5:H" & m + 4) '重新賦值ARR
Range("B5:H10000").ClearContents '清除(("B5:H10000")單元格區域內容
[B5].Resize(s, 7) = Application.Transpose(abr) ' '{B5]擴充區域後賦值等於abr轉置的值
Range("B5:H" & s + 4).Sort [H5] '對H列排序
For i = 1 To UBound(arr) '在ARR數組中循環
a = a + arr(i, 3) '給A賦值
Next
b = Val(Range("C2")) '給B賦值
If a - b < 0 Then '判定A-B小於0就執行下面程序
MsgBox "" & Range("B2") & "料號現有庫存 " & a & " 不夠本次出庫！程序退出。", 64, "溫馨提示" '彈出提示
Exit Sub
End If
For i = 1 To UBound(arr)
n = n + 1
ReDim Preserve br(1 To 7, 1 To n)
For j = 1 To 7
br(j, n) = arr(i, j)
Next
aa = aa + arr(i, 3)
If Val(aa) >= Val(b) Then
Exit For
End If
Next
br(3, n) = br(3, n) - (aa - b)
[J5].Resize(n, 7) = Application.Transpose(br) '上述代碼就是給[J5].Resize(n, 7)這個區域賦值等於轉置後的(br) 內容
End Sub