[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『80/120/160 箱ではなく、マスで。』（QPちゃん）
お世話になります。
《質問内容》
大幅な変更になってしまいますでしょうか？(>_<)
1マスの最大個数で、それを20マスで1セットと定義づけできるのでしょうか？
新しい箱詰割り当てシートのようにF列6行目以降を自動で入力されますでしょうか？
元々 syさま、に作って頂いた分でも少数は切り捨てて頂いてたので問題なかったのですが、
最大個数が異なる場合は同じマスに入れずに次のマスへ入れるようにできないか？と
提案されました。
1箱辺りの最大個数
●=80個
▲=120個
■=160個
1箱の中には仕切りがあり縦4マス*横5マス（計20マス）
仕切り1マス辺りの最大個数
●=4個
▲=6個
■=8個
●が46個
■が68個出荷される場合の現状の箱詰方法↓（○は無視してください）
箱詰割当シート
|[A] |[B] |[C] |[D]|[E] |[F]|
[5] |ShippingData|MODEL | |Qty| ←差異確認 | 1 |
[6] | 30-May-16 |701020000|C4 | 46| 46 | 46|
[7] | 30-May-16 |747010100|1.0D| 68| 68 | 68|
●が46個
■が68個出荷される場合の新しい箱詰方法↓（○は無視してください）
~~~~~~
箱詰割当シート
|[A] |[B] |[C] |[D]|[E] |[F]|[G]|
[5] |ShippingData|MODEL | |Qty| ←差異確認 | 1 | 2 |
[6] | 30-May-16 |701020000|C4 | 46| 46 | 46| |
[7] | 30-May-16 |747010100|1.0D| 68| 68 | 64| 4|
1マスの最大個数で、それを20マスで1セットと定義づけできるのでしょうか？
新しい箱詰割り当てシートのようにF列6行目以降を自動で入力されますでしょうか？
下記、現状の対応表シートとマクロです。
対応表シート
|[A] |[B]
[1] |MODEL |最大個数
[2] |701020000| 80
[3] |701020040| 80
[4] |701110200| 80
[5] |701110300| 80
[6] |701110400| 80
[7] |743040100| 80
[8] |743070100| 80
[9] |745030100| 120
[10]|745040100| 120
[11]|740020100| 120
[12]|741060100| 120
[13]|741110100| 120
[14]|745070100| 120
[15]|747010100| 160
[16]|747040100| 160
Sub 一発ミラクル()
Dim i As Long, j As Integer
Dim sh1 As Worksheet, sh2 As Worksheet
Dim base As Integer, capa As Integer, box As Integer, num As Integer, ratio As Integer
'変数宣言
Set sh1 = Sheets("箱詰割当")
Set sh2 = Sheets("対応表")
'箱の容量計算
base = WorksheetFunction.Lcm(sh2.Range("B2", sh2.Range("B" & Rows.Count).End(xlUp)))
capa = base
'箱詰計算
j = 6
For i = 6 To sh1.Range("B" & Rows.Count).End(xlUp).row
'1箱あたりの最大数計算
box = WorksheetFunction.VLookup(sh1.Cells(i, "B").Value, sh2.Range("A:B"), 2, 0)
'パターンごとの比率
ratio = base / box
num = sh1.Cells(i, "D").Value * ratio
Select Case capa - num
'箱容量が個数より多い
Case Is > 0
sh1.Cells(i, j).Value = Int(num / ratio)
capa = capa - num
'箱容量と個数が同数
Case 0
sh1.Cells(i, j).Value = Int(num / ratio)
capa = base
j = j + 1
'箱容量より個数が多い
Case Else
sh1.Cells(i, j).Value = Int(capa / ratio)
num = num - capa
If num >= base Then
sh1.Cells(i, j + 1).Resize(, Int(num / base)).Value = box
j = j + Int(num / base)
num = Int(num - Int(num / base) * box * ratio)
End If
j = j + 1
If num = 0 Then
capa = base
Else
sh1.Cells(i, j).Value = WorksheetFunction.RoundUp(num / ratio, 0)
num = sh1.Cells(i, j).Value * ratio
capa = base - num
End If
End Select
Next i
'表全体を取得して列に連番を振る
With sh1
.Range("F5", .Cells(5, .UsedRange.EntireColumn.Column + .UsedRange.EntireColumn.Columns.Count - 1)).Formula = "=Column()-5"
End With
'各列に6行目以降の合計を最終行へ
sh1.Range("B" & i).Value = "合計"
sh1.Range(sh1.Cells(i, "F"), sh1.Cells(i, j)).FormulaR1C1 = "=SUM(R6C:R[-1]C)"
sh1.Range("A5:EU5").Font.Bold = True
Set sh1 = Nothing
Set sh2 = Nothing
'幅
Columns("B").ColumnWidth = 11
Columns("C").ColumnWidth = 26
Columns("D").ColumnWidth = 10
Range("E:EU").ColumnWidth = 5
'罫線を引く（今回は空白セルを読み取り、範囲設定）
Range("A5").CurrentRegion.Borders.LineStyle = True
End Sub
＜ 使用 Excel：Excel2007、使用 OS：Windows7 ＞
こんばんわ。
出力結果のレイアウトはどうなるんですか？
マス単位に横に表示？
それとも表示自体は今まで通り箱単位で 1マス1種類の要素を加えるだけですか？
（sy） 2016/07/22(金) 17:59
こんばんは。
iPhoneから失礼します。
出力結果は、
新しい箱詰方法のイラストの下にある【箱詰割当シート】です。
マス単位に横に表示ではありません。
その通りです。
表示自体は箱単位で、1マスにMODELごとではなく
最大個数の同じものは入れれるようにしたいです。
最大個数が変わる場合は次のマスから入れるようにしたいです。
その結果を箱単位で出力されるようにしたいです。
（QPちゃん） 2016/07/22(金) 21:19
こんばんわ。
＞表示自体は箱単位で、1マスにMODELごとではなく ＞最大個数の同じものは入れれるようにしたいです。 ＞最大個数が変わる場合は次のマスから入れるようにしたいです。 ＞その結果を箱単位で出力されるようにしたいです。
要件は分かりました。
コードの修正自体は大した変更は必要なく、ループ内の3か所の num を変更するだけで良いと思います。
1箇所目、
Select Case capa - num を、
↓
Select Case capa - WorksheetFunction.RoundUp(num / (base / 20), 0) * (base / 20)
2か所目、
capa = capa - num を、
↓
capa = capa - WorksheetFunction.RoundUp(num / (base / 20), 0) * (base / 20)
3か所目、
capa = base - num を、
↓
capa = base - WorksheetFunction.RoundUp(num / (base / 20), 0) * (base / 20)
置き換えの式は3か所とも同じなので、 WorksheetFunction.RoundUp(num / (base / 20), 0) * (base / 20) を変数に代入しても良いですね。
質問とは関係ないですが、提示されたコードで気になる点がいくつかあります。
1、前回の質問で挿入した合計ですが、3行目では無く最終行になっていますが(それ自体は問題ないんですが)、
初めの質問では、[MODEL]がC列でしたが、実際はB列なんですね。
そしてご提示のコードでは、B列に合計の文字を記入するようになっていますが、前回はC列が[MODEL]と思っていたので、
C列以外に文字を表示させないと、次回のマクロ実行時にエラーになりますと言いましたが、今回ではB列が対象の列になります。
要は[MODEL]の列に合計の文字を表示させると、次回実行時に最終行の取得で合計のセルを余分にカウントするのでエラーになります。
今のコードのままでは初期化処理なども無いので、2回目に実行するとエラーになりますけど良いんですか？
2、1と被りますが、コードの実行前にシートの初期化は必要ないんですか？
Qtyの値に変更があった時などに再実行すると、今のままでは前のデータが表示されたままなので、
上書きされないセルのデータは残ったままになりますけど、良いんですか？
元ブックを複数コピーして、マクロを実行するのは一回限りと言う運用なら良いんですが、ちょっと気になりました。
（sy） 2016/07/22(金) 22:26
前回の質問とか初めの質問とか、言葉だけでは他に見てる人は経緯が分からないですね。。。
前回の質問
[[20160708170538]] 『最終行に合計を』（QPちゃん）
初めの質問
[[20160519153851]] 『VBA「160/80/120まで達したら右のセルへ」』（ＱＰちゃん）
（sy） 2016/07/22(金) 22:34
syさま、に作ってもらったものとは別にボタンが他に2つあります。
１つは全削除ボタン
もう1つはフォーマット作成ボタン
最後にsyさま、に作っていただいたボタン
1.すみません。
最初の頃は文章が長いと理解してもらいにくい。と、考えてしまいB列でもC列でも、後で変更すればいいのかな！と、大体で質問していました。
申し訳ありません。
元のデータが残ったままなので、
全削除ボタン→フォーマット作成ボタン→syさま、ボタン。
の順にクリックしています。
予測ですと全削除をしているから次回実行時にエラーが出ないのかなー。と適当な事を言ってみる…。
2.ありがとうございます。
だから、シートのクリアがあったんですね！
全削除ボタンを用意しているので消せるでいっか！と、思っていましたが数量の変更があった際にクリアにしてから再度出力されるように考えて下さったんですね。
感謝です。
syさまに気にさせてしまった事に対して私は回答出来たのでしょうか。
（QPちゃん） 2016/07/22(金) 23:12
シートの初期化は別で用意されていたんですね。
質問と関係ない部分は、杞憂でしたので忘れて下さい。
それとすいません。 先ほど提示した修正案忘れて下さい。 提示の修正だけでは、同じQtyが連続して並んでる時もマスを別けられてしまいました。 同じQtyが連続する時用に補正が必要でした。 今日はちょっと眠くて頭が働かないので、明日補正用コード考えてみます。
（sy） 2016/07/22(金) 23:46
おはようございます。
昨日提示の修正では、同じ最大個数なのにマスが区切られてしまうので、 IF文で同じ最大個数の時は今まで通りとしました。 この方法が一番修正箇所も少なく簡単だと思います。
後シート装飾が中途半端に、在ったり無かったりなのは後で間違いを引き起こす元になるので、 全てつけた方が良いです。 幅の設定以降の行の事です。
もしくは今回の要件では、ボタンで起動させるとの事なので、同じシート上にボタンがあるとして、 sh1の装飾を全て無しにするかですね。
どちらかに統一した方が良いです。 修正後のコードはsh1のシート装飾は無しで統一しています。
後、今回のコードに限ってはループより下に記述する範囲指定は、i,jで最大行列が取得出来ているので、 UsedRangeでの範囲取得部分を、i,jでの範囲指定に変更してみました。 ただ普通は最大行列は分からないので、UsedRangeなどで取得しないと行けません、今回のコードが特別なだけです。
Sub 一発ミラクル()
Dim i As Long, j As Integer, k As Long
Dim sh2 As Worksheet
Dim base As Integer, capa As Integer, box As Integer, box2 As Integer
Dim num As Integer, num2 As Integer, ratio As Integer
'変数宣言
Set sh2 = Sheets("対応表")
'箱の容量計算
base = WorksheetFunction.Lcm(sh2.Range("B2", sh2.Range("B" & Rows.Count).End(xlUp)))
capa = base
'箱詰計算
j = 6
k = Range("B" & Rows.Count).End(xlUp).Row
For i = 6 To k
'1箱あたりの最大数計算
box = WorksheetFunction.VLookup(Cells(i, "B").Value, sh2.Range("A:B"), 2, 0)
If i = k Then
box2 = box
Else
box2 = WorksheetFunction.VLookup(Cells(i + 1, "B").Value, sh2.Range("A:B"), 2, 0)
End If
'パターンごとの比率
ratio = base / box
num = Cells(i, "D").Value * ratio
num2 = WorksheetFunction.RoundUp(num / (base / 20), 0) * (base / 20)
If box = box2 Then num2 = num
Select Case capa - num2
'箱容量が個数より多い
Case Is > 0
Cells(i, j).Value = Int(num / ratio)
capa = capa - num2
'箱容量と個数が同数
Case 0
Cells(i, j).Value = Int(num / ratio)
capa = base
j = j + 1
'箱容量より個数が多い
Case Else
Cells(i, j).Value = Int(capa / ratio)
num = num - capa
If num >= base Then
Cells(i, j + 1).Resize(, Int(num / base)).Value = box
j = j + Int(num / base)
num = Int(num - Int(num / base) * box * ratio)
End If
j = j + 1
If num = 0 Then
capa = base
Else
Cells(i, j).Value = WorksheetFunction.RoundUp(num / ratio, 0)
num = Cells(i, j).Value * ratio
num2 = WorksheetFunction.RoundUp(num / (base / 20), 0) * (base / 20)
capa = base - IIf(box = box2, num, num2)
End If
End Select
Next i
Set sh2 = Nothing
'F列以降の5行目に連番を振る
Range("F5", Cells(5, j)).Formula = "=Column()-5"
'各列に6行目以降の合計を最終行へ
Range("B" & i).Value = "合計"
Range("F" & i, Cells(i, j)).FormulaR1C1 = "=SUM(R6C:R[-1]C)"
Range("A5:EU5").Font.Bold = True
'幅
Columns("B").ColumnWidth = 11
Columns("C").ColumnWidth = 26
Columns("D").ColumnWidth = 10
Range("E:EU").ColumnWidth = 5
'罫線を引く（今回は空白セルを読み取り、範囲設定）
Range("A5").CurrentRegion.Borders.LineStyle = True
End Sub
（sy） 2016/07/23(土) 10:26
おはようございます。
ありがとうございます。
動作確認をしてみます。
また、コメントの追記のミスを訂正していただきありがとうございます。
他にも変更していただいている箇所を見つけたり、
（sy）さま、に書いていただいたコード（Functionプロシージャ等）の意味や理解を
できるよに勉強していきます。
「質問と関係ない部分は、杞憂でしたので・・」との事ですが、
心配してくださったことがとてもうれしく思いました。
ありがとうございます。
（QPちゃん） 2016/07/23(土) 12:29
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.