2017-03-01 14 views
0

任務:爲零件號創建一個報表,該零件號在日期桶中顯示幾種類型(現貨,訂單等),每種類型總計爲具體範圍。使用數組設置篩選查詢並在Access VBA中返回一系列計算

For example: 
Item 1 => (could be over 2000) 
       2/5/2017 2/19/2017 2/28/2017 (30 weeks) 
On Hand   20   42   33 
On Order   0   5   4 

每個項目都顯示在它自己的頁面上,包含關於該項目的相關元數據。每個日期桶基於用戶輸入的開始日期,並根據數據集運行計算以確定哪些桶以及總計的內容。

我有這個報告完全適用於一個項目。用戶類型一個項目,選擇一個日期,該報告使用以下方法創建:

Inventory Meta general information and description of the item 
Inventory Detail gets all the detailed information 
Inventory Totals gets totals for each Types 
GetInventory() VBA sets up the buckets and populates the totals 

使用查詢來獲取日期桶或許會更容易將數據放到報告。使用210個計算列(7種類型,30周)創建查詢不是一種合理的方法。

當然,一次選擇一個項目不是想要的。

我有一個選擇框,可以獲取所選部件編號併爲庫存元(主要報表)動態創建查詢。我有類似的代碼工作,與庫存彙總(子報告)一起運行,以便爲此動態創建查詢。

但是,與Inventory Totals查詢一樣,每個日期都是唯一值,並且是自己的行。我需要做的是運行代碼爲所選的每個項目構建桶。

我被卡住了。

我已經創建了一個項目編號數組(無論選擇了什麼)。我可以看到陣列中有什麼。

我似乎無法弄清楚的是如何將每個代碼提供給運行日期比較和計算的代碼,以便我可以獲得每個部件號的完整數據集。

有了一個號碼很容易......「這一個」

vItem = [Forms]![fOptions]![ItemNumber] 
Set db = CurrentDb 
    strSelect = "Select * FROM qInventoryTotals WHERE qInventoryTotals.ItemNumber = [this_one]" 
Set qdf = db.CreateQueryDef(vbNullString, strSelect) 
    qdf.Parameters("this_one").Value = vItem 
Set inv = qdf.OpenRecordset 

我來是要使報告中顯示的同一組數據的所有部分的數字最接近的一次。我懷疑有一些小而關鍵的東西,比如某個特定循環開始的位置或者我錯過的變量或其他東西。

以下結果是一個消息框,重複每個零件號的相同總數。

Private Sub CreateOne_Click() 

On Error GoTo Err_cmdOpenQuery_Click 

'----------- Selection box check for dates ------------- 
If IsNull(Forms!fFish1!Week1) Then 
     MsgBox "A Sunday date must be selected", , "Please select a date" 
    ElseIf Weekday(Forms!fFish1!Week1) = 1 Then 
     'MsgBox "That is Sunday" 
     Forms!fFish1!Week1 = Forms!fFish1!Week1 
    Else 
     MsgBox "Starting Week needs to be a Sunday date" _ 
       , , "Sorry, that's not Sunday" 
     ' clears the 'not Sunday' selection 
     Forms!fFish1!Week1 = "" 
    Exit Sub 
End If 
'------------------------------------------------- 
' Declarations ===================================== 

    Dim db As DAO.Database 
    Dim iMeta As DAO.QueryDef 

    Dim i As Integer 
    Dim strSQL As String 
    Dim strWhere As String 
    Dim strIN As String 
    Dim flgSelectAll As Boolean 
    Dim varItem As Variant 

    Dim strSlect As String 
    Dim vItem As Variant 


' Setup ------------------------------------- 
    Set db = CurrentDb() 
    strSQL = "SELECT * FROM qInventoryTotals2" 

'---------------------------------------------------------------------- 
' Get whatever is selected and loop through the selections 
' This defines which numbers are in the list 
'---------------------------------------------------------------------- 
    For i = 0 To Forms!fFish1.box4.ListCount - 1 
     If Forms!fFish1.box4.Selected(i) Then 
      If Forms!fFish1.box4.Column(0, i) = "All" Then 
       flgSelectAll = True 
      End If 
      strIN = strIN & "'" & Forms!fFish1.box4.Column(0, i) & "'," 
     End If 
    Next i 

    'Create the WHERE string, and strip off the last comma of the IN string 
    strWhere = " WHERE [ItemNumber] in " & _ 
       "(" & Left(strIN, Len(strIN) - 1) & ")" 

    'If "All" was selected in the listbox, don't add the WHERE condition 
    If Not flgSelectAll Then 
     strSQL = strSQL & strWhere 
    End If 
'------------------------------------------------------- 

' Create a query that has all the selected item numbers 
    db.QueryDefs.Delete "qInventoryTotals3" 
    Set iMeta = db.CreateQueryDef("qInventoryTotals3", strSQL) 

    Set inv = iMeta.OpenRecordset 

'========================================================================== 
' Create an array to pull out each of the Item numbers one at a time 
Dim Count As Integer, r As Integer 
Count = 0 

For i = 0 To Forms!fFish1.box4.ListCount - 1 
     If Forms!fFish1.box4.Selected(i) Then 
      vItem = Forms!fFish1.box4.Column(0, i) 
      'vItemFilter = Forms!fFish1.box4.Column(0, i) 
      'MsgBox (vItem), , "one by one" 
      Count = Count + 1 
     End If 
    Next i 

''MsgBox (Count), , "count how many items are in the set" 
' Get the count for how many items are in the currently selected list 
' Displays one item at a time - 

' Set up the array ------------------------------ 
'------------------------------------------------ 
ReDim vItem(Count) 
    r = 0 

    For i = 0 To Forms!fFish1.box4.ListCount - 1 
     If Forms!fFish1.box4.Selected(i) Then 
      vItem(r) = Forms!fFish1.box4.Column(0, i) 
      r = r + 1 
     End If 
    Next i 


    'Check the values stored in array 
    ''For i = 0 To Count - 1 
     ''MsgBox vItem(i), , "show all values from the array" 
    ''Next 
' have all values from the array. Each in it's own message box 
'=============================================================================== 

' Set up the item numbers --------------------------- 

Dim part As Variant 
part = vItem 

    With vItem 
     For i = LBound(vItem) To UBound(vItem) - 1 
     MsgBox ("There are" & " " & (vItem(i)) & " " & "fishies"), , "Whatcha' got now?" 

' cycles through each number 

' Past Due ============================================ 
Dim tPOPast As Double 
Dim tBCPast As Double 
Dim tBPast As Double 
Dim tEPast As Double 

    If inv!ItemNumber = part(i) And inv.Fields("RequiredDate") < Forms!fFish1!Week1 Then 
    'displays the first part number with it's value, then the remaining numbers with no value 

' If inv.Fields("RequiredDate") < Forms!fFish1!Week1 Then 
    'displays each of the part numbers with the same value 


     tBPast = inv.Fields("TotalOnHand") 
     tPOPast = tPOPast + inv.Fields("SumOfSupply") 
     tBCPast = tBCPast + inv.Fields("SumOfDemand") 

' Calculate ending inventory for the week =================== 
     tEPast = tBPast + tPOPast + tBCPast 

' Show something for testing ============================== 

     MsgBox (tBPast & " " & part(i)), , "show Me the money" ' displays same total for each part number 

    End If 
'end this condition, next condition follows 
'----------------- do it again ------------------------------- 
    Next 

' Finished with the weekly buckets ===================================== 

    End With 
'========================================================================= 

'-------------------- error management for the selection box ------------------ 
Exit_cmdOpenQuery_Click: 
    Exit Sub 

Err_cmdOpenQuery_Click: 

    If Err.Number = 5 Then 
     MsgBox "Pick one, or more, item numbers from the list" _ 
       , , "Gotta pick something!" 
     Resume Exit_cmdOpenQuery_Click 

    Else 
     'Write out the error and exit the sub 
     MsgBox Err.Description 
     Resume Exit_cmdOpenQuery_Click 
    End If 
'--------------------------------------------------------------------------- 

End Sub 

回答

0

我找到的解決方案是爲數組中的值設置變量並使用它們動態更新表。從那以後,我創建了一個查詢來彙總這些值並將其用作報告的基礎。關鍵是GetRows()

獲取獨特的項目和讀取數據的行成第一陣列

Dim rNum As Integer 

rNum = myItems.RecordCount 

    Dim varItem As Variant 
    Dim intRi As Integer 'rows of unique items 
    Dim intCi As Integer 'columns of unique items 
    Dim intNCi As Integer 
    Dim intRCi As Integer 

varItem = myItems.GetRows(rNum) 
    intNRi = UBound(varItem, 2) + 1 
    intNCi = UBound(varItem, 1) + 1 

For intRi = 0 To intNRi - 1 
    For intCi = 0 To intNCi - 1 
    vItem = varItem(intCi, intRi) 

使用vItem動態創建一個新的記錄設置每週桶

​​

計算記錄,創建第二個陣列

Dim invNum As Integer 

invNum = inv.RecordCount 

    Dim varRec As Variant 
    Dim intR As Integer 
    Dim intC As Integer 
    Dim intNC As Integer 
    Dim intRC As Integer 

    Dim cItem As String 
    Dim cRequired As Date 
    Dim cPO As Double 
    Dim cBC As Double 
    Dim cOnHand As Double 

varRec = inv.GetRows(invNum) 
    intNR = UBound(varRec, 2) + 1 
    intNC = UBound(varRec, 1) + 1 

For intR = 0 To intNR - 1 
    For intC = 0 To intNC - 1 

     cItem = varRec(0, intR) 
     cRequired = varRec(1, intR) 
     cOnHand = varRec(2, intR) 
     cPO = varRec(3, intR) 
     cBC = varRec(4, intR) 
     cSO = varRec(5, intR) 
     cPD = varRec(6, intR) 
     cIN = varRec(7, intR) 
     cJT = varRec(8, intR) 
     cWO = varRec(9, intR) 


'------------- finish getting inventory columns -------------------- 
    Next intC 

然後每週設置水桶

If cRequired < Week1 Then 

     recOut.AddNew 
     recOut.Fields("ItemNumber") = cItem 
     recOut.Fields("tB") = cOnHand 
     recOut.Fields("tPO") = cPO 
     recOut.Fields("tBC") = cBC 
     recOut.Fields("tSO") = cSO 
     recOut.Fields("tPD") = cPD 
     recOut.Fields("tIN") = cIN 
     recOut.Fields("tJT") = cJT 
     recOut.Fields("tWO") = cWO 
     recOut.Fields("tE") = cOnHand + cPO + cBC + cSO + cPD + cIN + cJT + cWO 
     recOut.Fields("RequiredDate") = cRequired 
     recOut.Fields("GroupDate") = Week1 
     recOut.Update 

'  tE0 = cOnHand + cPO + cBC + cSO + cPD + cIN + cJT + cWO 

Dim tryme As Double 
     tryme = DLookup("teMe", "qBuckets", "GroupDate = Week1") 
     tE0 = tryme 

    End If 
相關問題