| |
▼まくりん さん：
こんばんは、興味があったので作ってみました。
新しいWORKBOOKの標準モジュールにコピーして下さい。
先ず 表示を実行し色のついたセル６つに入力してから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
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
- 07/7/30(月) 16:27 -
