HOME > Q&A > Access （VBA）

Access （VBA）
Access VBAに関するフォーラムです。
  • 掲示板への投稿には会員登録（無料）が必要です。会員登録がまだの方はこちら
  • 「掲示板ご利用上のお願い」に反するご記入はご遠慮ください。
  • Q&A掲示板の使い方はこちらをご覧ください
トピックに返信
質問

 
(Windows 10 Pro : Access 2016)
倉庫の移管データ（ピッキング車両積載明細）作成
投稿日時: 20/10/30 12:48:58
投稿者: voowanwan

お世話になっております。
 
在庫置き場の倉庫全移動をします。
ピッキングデータ兼トラック別積載明細データを作成したくやっていのですが
このPickデータが作成できずに困っています。
どなたか助けていただけないでしょうか。
 
 
 
■トラック条件
①トラックへの積込はパレットである。
②パレットへは16パレットで満車となるので次の車となる。
A商品14PL　+　B商品2PL→満車
 
③ただし一部2段で積み重ねが効く商品がある。
A商品14PL　+　段積みが可能なC商品　4PL　→満車
 
■倉庫から取り出す（ピッキング）
①DT_在庫というテーブルからデータを作成する
②Pickする順番は　倉庫内の北とか南エリアごとにロケーション順番にPickする（はじからです）
③ただし下記のトラック積込条件がある。
④下記のようなケースもあります。
A商品14PL　+　段積みが可能なC商品3PLで次のロケーションが段積み不可商品1PLですと
14+0.5*3PL+1　＝16.5となりますので15.5で満車とします。
 
 
■できないこと。
いろいろ書きなおしていますが容積が16（15.5）にならなかったり残数が計算できなかったり。
変数と条件の整理ができていないのが原因とは思います。
下記がVBAですが一部削除置き換えしています。
 
 
Public Function BatchDataMake() As Boolean
On Error GoTo Err_BatchDataMake
'--------------------------------------------------------
'改修2020/10/27
'作成
'Pickデータ作成
'--------------------------------------------------------
 Dim cncBatch As ADODB.Connection
 Dim cmdBatch As ADODB.Command
 Dim rstNOWDB As ADODB.Recordset
 Dim rstWKBATCH As ADODB.Recordset
  
  
 Dim strLoca As String 'ロケ
 Dim strCD As String '商品CD
 Dim strCDName As String '商品名前
 Dim strLot As String 'ロット
 Dim strClass As String '分類
  
  
’
 Dim intMoveNo As Integer '移管順番
 Dim intStack As Integer '車に積載するパレット数累計
 Dim intRest As Integer 'ロケーションにあったパレット数で積みきれない。次の車に回すパレット数。ロケーションに18あったら　18-16＝2
 Dim intCarNo As Integer '車番　Pickリスト　NO　上から1から採番
 Dim intPick As Integer　’Pickするパレット数
 
  
 '容量　M3
 Dim intM3Stack As Integer 'トラック積載が16になるまでの 架空数字　15.5の場合で次が1なら16.05で積みきれないので15.5で終了
 Dim intM3Pick As Integer 'Pick行の個数×容量
 Dim intM3One As Integer '1個単位の容量
 Dim intM3Rest As Integer 'ロケーションにあったパレット数で積みきれないパレット数を次の車に回す容積
 Dim intSEQ As Integer 'シーケンス
   
 
   
    BatchDataMake = True
 
  
    Set cncBatch = CurrentProject.Connection
    Set rstNOWDB = New ADODB.Recordset
    Set rstWKBATCH = New ADODB.Recordset
    Set cmdBatch = New ADODB.Command
    Set cmdBatch.ActiveConnection = cncBatch
   
  
 'クリア
    DoCmd.SetWarnings False
    DoCmd.RunSQL "delete * from WK_Pick", -1
     
 'SQLセット
    SQLSelect = "Select * "
    SQLFrom = "From DT_在庫 "
    SQLOrder = "Order By エリア, ロケーション, 商品コード, ロット "
    
    strSQL = SQLSelect & SQLFrom & SQLOrder & ";"
    rstNOWDB.Open strSQL, cncBatch, adOpenKeyset, adLockReadOnly
 
    
 
 '追加先テーブルオープン
     rstWKBATCH.Open "WK_Pick", cncBatch, adOpenKeyset, adLockOptimistic
  
 '初期化
  
    intSEQ = 0　’シーケンス
    intRest = 0　’1ロケーションにある
    intStack = 0　
    intCarNo = 1　車NO
    intM3Stack = 0
    intM3Pick = 0
     
    i = 1
    
     
 Do While Not rstNOWDB.EOF
           
            '初期化
             
         
            strLoca = rstNOWDB![ロケーション]
            strCD = rstNOWDB![商品コード]
            strCDName = rstNOWDB![商品名]
            strLot = rstNOWDB![ロット]
            intM3One = rstNOWDB![容積]　　　'2段積み可能なら0.5、2段積み不可能なら1
 
 
'先送りが0以上なら
            If intM3Rest > 0 Then
             
　　　　　　　　　　'仮Pick数確定させる★★★★★★★★★★★★★★★★★★★★★★★★★★★★
                            If intM3Rest + intM3Stack > 16 Then
                                    intM3Pick = 16 - intM3Stack
                                    intPick = intM3Pick / intM3One
            '
                            '16以下だったら
                            Else
                                    intPick = intRest
                                    intM3Pick = intPick * intM3One
                             
                            End If
                 
                         
            Else
                intPick = rstNOWDB![パレット数]
                intM3Pick = intPick * intM3One
                 
                 
                            If intM3Rest + intM3Stack > 16 Then
                                    intM3Pick = 16 - intM3Stack
                                    intPick = intM3Pick / intM3One
            '
                            '16以下だったら
                            Else
                                    intPick = intPick
                                    intM3Pick = intPick * intM3One
                             
                            End If
                             
             
            End If
 
        
'Pick数+スタックが16M3以下の場合 ★この場合、Pick数が30とかもある
                        If intM3Pick + intM3Stack < 16.01 Then
                         
                         
                                        'Pickあまり送り
                                        intRest = 0
                                        intM3Rest = 0
                                         
                                        'pick
                                        intPick = intPick
                                        intM3Pick = intM3Pick
                                         
                                        '積載容量余り
                                        intStack = intStack + intPick
                                        intM3Stack = intM3Stack + intM3Pick
                                         
                                                      
'送り込みが16M3以上の場合 積みきれない
                 
                        Else
                         
   
                                        'pick（積める容積）
                                        intM3Pick = 16 - intM3Stack
                                        intPick = intM3Pick / intM3One
                                         
                                        
                                        'Pickあまり送り計算
                                        intRest = rstNOWDB![パレット数] - intPick
                                        intM3Rest = intRest * intM3One
                                                                                                                        
                                         
                                        '今の車の積載容量余りがなくなる
                                        intStack = 0
                                        intM3Stack = 0
                                         
                             
                                       
                        End If
                         
                         
                         rstWKBATCH.AddNew
                     
                                        intSEQ = intSEQ + 1
                                 
                                        rstWKBATCH![ID] = intSEQ
                                        rstWKBATCH![車番] = intCarNo
                                        rstWKBATCH![ロケーション] = strLoca
                                        rstWKBATCH![商品コード] = strCD
                                        rstWKBATCH![商品名] = strCDName
                                        rstWKBATCH![ロット] = strLot
                    rstWKBATCH![パレット数] = intPick
                                        rstWKBATCH![エリア] = rstNOWDB![エリア]
                                        rstWKBATCH![輸送容積] = intM3Pick
                                                                                 
                             
                        rstWKBATCH.Update
                         
                        i = i + 1
                         
 
                                                     
                                                     
' If intRest = 0 Then
' rstNOWDB.MoveNext
' End If
                 
                If intM3Rest = 0 Then
                    rstNOWDB.MoveNext
                End If
                 
                 
                 
                '満車の場合、車番変更
                If intStack = 0 Then
                    '車番変更
                    intCarNo = intCarNo + 1
                     
                End If
 
                                   
Loop
           
           
           
 
 
GoTo DBCLOSE
   
Err_BatchDataMake:
    BatchDataMake = False
    MsgBox (Err.Number & Err.Description)
     
     
Exit_BatchDataMake:
    BatchDataMake = False
     
 
DBCLOSE:
    If rstNOWDB.State = adStateOpen Then
        Set rstNOWDB = Nothing
    End If
 
    If rstWKBATCH.State = adStateOpen Then
        Set rstWKBATCH = Nothing
    End If
 
    If cncBatch.State = adStateOpen Then
        Set cncBatch = Nothing
    End If
 
End Function
回答
投稿日時: 20/10/30 16:19:10
投稿者: sk

引用:
パレットへは16パレットで満車となるので次の車となる。
A商品14PL　+　B商品2PL→満車

引用:
ただし一部2段で積み重ねが効く商品がある。
A商品14PL　+　段積みが可能なC商品　4PL　→満車

引用:
容積が16（15.5）にならなかったり残数が計算できなかったり

引用:
Dim intM3Stack As Integer 'トラック積載が16になるまでの 架空数字　15.5の場合で次が1なら16.05で積みきれないので15.5で終了
Dim intM3Pick As Integer 'Pick行の個数×容量
Dim intM3One As Integer '1個単位の容量
Dim intM3Rest As Integer 'ロケーションにあったパレット数で積みきれないパレット数を次の車に回す容積

引用:
intM3One = rstNOWDB![容積]　　　'2段積み可能なら0.5、2段積み不可能なら1

小数計算を行なわれるのであれば、その計算結果を
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
------------------------------------------------------------
トピックに返信