Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


31438 / 76732 ←次へ | 前へ→

【50545】Re:段ボールケースに何箱入れられるか?
回答  わいわい  - 07/7/31(火) 19:29 -

引用なし
パスワード
   ▼まくりん さん:
こんばんは、興味があったので作ってみました。
新しいWORKBOOKの標準モジュールにコピーして下さい。
先ず 表示を実行し色のついたセル6つに入力してからtestを実行して下さい。
>sub testとか使ったことがない関数がありますね、う〜ん...
>なかなか、というか、これはかなり私的に頑張らないと...
>
質問箱の名前の通りVBAで作成しています。EXCELで準備された関数ではないのでご注意下さい。

Sub 表示()
  Dim MyArray(8)
  With Worksheets("Sheet1")
    .Cells(1, 1).Value = "外箱の寸法"
    .Cells(2, 1).Value = "DB_X"
    .Cells(2, 2).Value = "DB_Y"
    .Cells(2, 3).Value = "DB_Z"
    .Cells(5, 1).Value = "商品の寸法"
    .Cells(6, 1).Value = "X"
    .Cells(6, 2).Value = "Y"
    .Cells(6, 3).Value = "Z"
    .Cells(9, 1).Value = "a"
    .Cells(9, 2).Value = "b"
    .Cells(9, 3).Value = "c"
    .Cells(12, 1).Value = "l"
    .Cells(12, 2).Value = "m"
    .Cells(12, 3).Value = "n"
    .Cells(12, 4).Value = "l×m×n"
    .Cells(12, 5).Value = "隙間処理後"
    .Cells(12, 6).Value = "X方向"
    .Cells(12, 7).Value = "Y方向"
    .Cells(12, 8).Value = "Z方向"
    .Cells(20, 1).Value = "詰め込み個数"
    .Cells(21, 1).Value = "容積比較個数"
    .Cells(22, 1).Value = "比率"
    .Range("A3:C3").Interior.ColorIndex = 35
    .Range("A7:C7").Interior.ColorIndex = 35
  End With
End Sub
Sub test()
'詰め込み可能な最終個数
  Dim 最終個数(6) As Integer
  Dim 解答 As Integer
'ダンボールケースの寸法
  Dim DB_X As Double, DB_Y As Double, DB_Z As Double
'商品ケースの寸法
  Dim x As Double, y As Double, z As Double
  Dim A As Double, B As Double, C As Double
  
  With Worksheets("sheet1")
'ダンボールケースの寸法を取得
    DB_X = .Cells(3, 1).Value
    DB_Y = .Cells(3, 2).Value
    DB_Z = .Cells(3, 3).Value
'商品ケースの寸法を取得
    x = .Cells(7, 1).Value
    y = .Cells(7, 2).Value
    z = .Cells(7, 3).Value
'大きい順に並べ替え
    A = Application.Max(x, y, z)
    C = Application.Min(x, y, z)
    If x <> A And x <> C Then
      B = x
    ElseIf y <> A And y <> C Then
      B = y
    Else
      B = z
    End If
    .Cells(10, 1).Value = A
    .Cells(10, 2).Value = B
    .Cells(10, 3).Value = C
  
    最終個数(1) = 計算1(1, DB_X, DB_Y, DB_Z, A, B, C)
    最終個数(2) = 計算1(2, DB_X, DB_Z, DB_Y, A, B, C)
    最終個数(3) = 計算1(3, DB_Y, DB_X, DB_Z, A, B, C)
    最終個数(4) = 計算1(4, DB_Y, DB_Z, DB_X, A, B, C)
    最終個数(5) = 計算1(5, DB_Z, DB_X, DB_Y, A, B, C)
    最終個数(6) = 計算1(6, DB_Z, DB_Y, DB_X, A, B, C)
'計算結果比較
    For i = 1 To 6
      If 解答 < 最終個数(i) Then 解答 = 最終個数(i)
      .Cells(12 + i, 5).Value = 最終個数(i)
    Next i
    
    .Cells(20, 2).Value = 解答
'容積−体積比較による個数
    .Cells(21, 2).Value = Int(DB_X * DB_Y * DB_Z / (x * y * z))
'容積−体積比較による個数に対する解答の比率
    .Cells(22, 2).Value = 解答 / Int(DB_X * DB_Y * DB_Z / (x * y * z))
  End With
End Sub
Function 計算1(i, DBX, DBY, DBZ, A, B, C)
'縦、横、高さ方向の個数
  Dim l As Integer, m As Integer, n As Integer
'箱詰め済み長さ
  Dim X1 As Integer, Y1 As Integer, Z1 As Integer
'隙間長さ
  Dim dX As Integer, dY As Integer, dZ As Integer
      
'縦、横、高さ方向の個数算出
  l = Int(DBX / A)
  m = Int(DBY / B)
  n = Int(DBZ / C)
'箱詰め済み長さ算出
  X1 = A * l
  Y1 = B * m
  Z1 = C * n
'隙間長さ算出
  dX = DBX - X1
  dY = DBY - Y1
  dZ = DBZ - Z1
'X > Y > Z > dZよりdZについては検討不要
  Worksheets("sheet1").Cells(12 + i, 1).Value = l
  Worksheets("sheet1").Cells(12 + i, 2).Value = m
  Worksheets("sheet1").Cells(12 + i, 3).Value = n
  Worksheets("sheet1").Cells(12 + i, 4).Value = l * m * n
  Worksheets("sheet1").Cells(12 + i, 6).Value = DBX
  Worksheets("sheet1").Cells(12 + i, 7).Value = DBY
  Worksheets("sheet1").Cells(12 + i, 8).Value = DBZ
  aaa = l * m * n + 計算2(dX, DBY, DBZ, A, B, C) + 計算2(X1, dY, DBZ, A, B, C)
  bbb = l * m * n + 計算2(dX, Y1, DBZ, A, B, C) + 計算2(DBX, dY, DBZ, A, B, C)
  
  計算1 = Application.Max(aaa, bbb)
End Function
Function 計算2(DBX, DBY, DBZ, A, B, C)
'詰め込み可能な個数
  Dim 個数(6) As Integer
  Dim 回答 As Integer
 
'CASE 1
  個数(1) = Int(DBX / A) * Int(DBY / B) * Int(DBZ / C)
'CASE 2
  個数(2) = Int(DBX / A) * Int(DBY / C) * Int(DBZ / B)
'CASE 3
  個数(3) = Int(DBX / B) * Int(DBY / A) * Int(DBZ / C)
'CASE 4
  個数(4) = Int(DBX / B) * Int(DBY / C) * Int(DBZ / A)
'CASE 5
  個数(5) = Int(DBX / C) * Int(DBY / A) * Int(DBZ / B)
'CASE 6
  個数(6) = Int(DBX / C) * Int(DBY / B) * Int(DBZ / A)
 
'計算結果比較
  For i = 1 To 6
    If 回答 < 個数(i) Then 回答 = 個数(i)
  Next i
  計算2 = 回答
End Function

2 hits

【50512】段ボールケースに何箱入れられるか? まくりん 07/7/30(月) 16:18 質問
【50513】Re:段ボールケースに何箱入れられるか? ちくたく 07/7/30(月) 16:27 発言
【50514】Re:段ボールケースに何箱入れられるか? マクロマン 07/7/30(月) 16:34 発言
【50516】Re:段ボールケースに何箱入れられるか? わいわい 07/7/30(月) 17:00 発言
【50520】Re:段ボールケースに何箱入れられるか? まくりん 07/7/30(月) 20:01 お礼
【50524】Re:段ボールケースに何箱入れられるか? 07/7/31(火) 0:16 回答
【50526】Re:段ボールケースに何箱入れられるか? わいわい 07/7/31(火) 7:12 発言
【50529】Re:段ボールケースに何箱入れられるか? わいわい 07/7/31(火) 8:34 発言
【50536】Re:段ボールケースに何箱入れられるか? まくりん 07/7/31(火) 12:00 お礼
【50545】Re:段ボールケースに何箱入れられるか? わいわい 07/7/31(火) 19:29 回答
【50577】Re:段ボールケースに何箱入れられるか? まくりん 07/8/2(木) 13:55 発言
【50579】Re:段ボールケースに何箱入れられるか? わいわい 07/8/2(木) 15:06 発言
【50612】Re:段ボールケースに何箱入れられるか? まくりん 07/8/4(土) 19:09 お礼
【50866】Re:段ボールケースに何箱入れられるか? まくりん 07/8/20(月) 18:59 お礼

31438 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free