Access (VBA) |
![]() ![]() |
(Windows 10 Pro : Access 2016)
倉庫の移管データ(ピッキング車両積載明細)作成
投稿日時: 20/10/30 12:48:58
投稿者: voowanwan
|
---|---|
お世話になっております。
|
![]() |
投稿日時: 20/10/30 16:19:10
投稿者: sk
|
---|---|
引用: 引用: 引用: 引用: 引用: 小数計算を行なわれるのであれば、その計算結果を Integer 型の変数に代入されるのは止めましょう。 (標準モジュール) ------------------------------------------------------------ Option Compare Database Option Explicit Public Function BatchDataMake() As Boolean On Error GoTo Err_BatchDataMake Const CapacityInCar As Long = 16 Dim cncBatch As ADODB.Connection Dim rstStockMaster As ADODB.Recordset Dim rstPickerWork As ADODB.Recordset Dim strSQL As String Dim varVolume As Variant Dim lngPalletCount As Long Dim lngSeq As Long Dim lngCarID As Long Dim varVolumeTotal As Variant Dim varCapacity As Variant Dim lngLoadablePallets As Long Dim varCarryVolume As Variant Dim blFullLoaded As Boolean BatchDataMake = False Set cncBatch = CurrentProject.Connection cncBatch.BeginTrans On Error GoTo RollBack_BatchDataMake strSQL = "DELETE * FROM [WK_Pick]" cncBatch.Execute strSQL Set rstPickerWork = New ADODB.Recordset rstPickerWork.Open "WK_Pick", cncBatch, adOpenKeyset, adLockOptimistic strSQL = "SELECT * " & _ " FROM [DT_在庫]" & _ " WHERE [パレット数]*[容積]>0" & _ " ORDER BY [エリア], [ロケーション], [商品コード], [ロット]" Set rstStockMaster = New ADODB.Recordset rstStockMaster.Open strSQL, cncBatch, adOpenKeyset, adLockReadOnly lngSeq = 0 lngCarID = 1 varVolumeTotal = 0 varCapacity = CDec(CapacityInCar) Do Until rstStockMaster.EOF lngPalletCount = rstStockMaster![パレット数].Value varVolume = CDec(rstStockMaster![容積].Value) Do While lngPalletCount > 0 If varCapacity > lngPalletCount * varVolume Then lngLoadablePallets = lngPalletCount Else lngLoadablePallets = Int(varCapacity / varVolume) blFullLoaded = True End If varCarryVolume = lngLoadablePallets * varVolume If lngLoadablePallets > 0 Then lngSeq = lngSeq + 1 rstPickerWork.AddNew rstPickerWork![ID].Value = lngSeq rstPickerWork![車番].Value = lngCarID rstPickerWork![エリア].Value = rstStockMaster![エリア].Value rstPickerWork![ロケーション].Value = rstStockMaster![ロケーション].Value rstPickerWork![商品コード].Value = rstStockMaster![商品コード].Value rstPickerWork![商品名].Value = rstStockMaster![商品名].Value rstPickerWork![ロット].Value = rstStockMaster![ロット].Value rstPickerWork![パレット数].Value = lngLoadablePallets rstPickerWork![輸送容積].Value = varCarryVolume rstPickerWork.Update lngPalletCount = lngPalletCount - lngLoadablePallets varVolumeTotal = varVolumeTotal + varCarryVolume varCapacity = varCapacity - varCarryVolume End If If blFullLoaded Then Debug.Print "車番" & lngCarID & ": 積載 " & varVolumeTotal & " / 空き " & varCapacity lngCarID = lngCarID + 1 blFullLoaded = False varVolumeTotal = 0 varCapacity = CDec(CapacityInCar) End If Loop rstStockMaster.MoveNext Loop If blFullLoaded = False Then Debug.Print "車番" & lngCarID & ": 積載 " & varVolumeTotal & " / 空き " & varCapacity End If cncBatch.CommitTrans On Error GoTo Err_BatchDataMake BatchDataMake = True Exit_BatchDataMake: On Error Resume Next Set rstPickerWork = Nothing Set rstStockMaster = Nothing Set cncBatch = Nothing Exit Function RollBack_BatchDataMake: cncBatch.RollbackTrans Err_BatchDataMake: Dim strErr As String strErr = Err.Number & ": " & Err.Description Debug.Print strErr MsgBox strErr, vbCritical, "BatchDataMake" Resume Exit_BatchDataMake End Function ------------------------------------------------------------ |