[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBA「160/80/120まで達したら右のセルへ」』（ＱＰちゃん）
C DE F G H I J K
MODEL Qty
A111 40 40
A111 40 40
A111 40 40
A111 60 40 20
A111 40 40
A111 40 40
A111 80 60 20
A111 100 100
A222 100 40 60
A222 100 100
A222 100 100
B111 10 10
B111 10 10
B222 16 10 6
C222 16 16
C333 16 16
160 160 160 160 130 38
こんにちは。
ExcelVBAについて質問です。
D列の6行目から数字が入っています。最終行は変わる事があります。
C列のMODELとD列の数量を参照し、F列6行目から順にコピーしていくマクロを教えてください。
※ただし、MODELの頭文字がAの場合は160までBは80までCは120までで、
例えばMODELの頭文字がAの場合一つの列の合計が160までいったらG列へ余りの数を入力され160までいったらまた次の列へ入力されるようにしたいです。
同じくMODELの頭文字がBの場合一つの列に80までいったら次の列へ余りの数字を入力されるようにしたいです。
それの繰り返し処理をD列の最終行まで行う。
F列の6行目からK列の21行目までを自動で入力させたいです。
−−−質問側ですが「？」と感じる事−−−
違うMODELが混載した場合、マクロでできることなのか・・・。A/B/CのMODELの最小公倍数が関係しているのかどうか・・数学の問題なのどうか・・
出荷作業で3つのタイプの箱のサイズがあって、すべて同じ箱のサイズで出荷しています。
普段混載の場合、ピッチピチにいれたり、余裕をもって入れたりもします。
なので、混載の場合は入ればいっか・・ぐらいです。
説明不足な点があると思いますが宜しくおねがいします。
＜ 使用 Excel：Excel2007、使用 OS：Windows7 ＞
これを、頭文字ブレーク部分を同じロジック内で処理することも、可能でしょうけど βに、いそいでやれといわれれば、前スレのコードを、サブルーティンにしたてあげ
・頭文字ごとの一意のリストをつくり ・その文字ごとに作業シートにフィルターで抜出し ・作業シート上で頭文字ごとのMax値を与えて処理させ ・できあがったものを、しかるべきポジションに貼り付け
こんなループ処理を行うと思います。
コードとは別に、アップされた例では、頭文字がかわったものの最初が その前の、最後の箱と混載？
そちらの業務運用手順はわかりませんけど最後の箱とは異なる新しい箱（１つ右の列）に詰めたほうがいいのでは？
（β） 2016/05/19(木) 17:25
Sub test()
Dim i As Long
Dim iC As Long
Dim iw1 As Long
Dim iw2 As Long
iC = 2
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row
If iw1 <= 0 Then
iw1 = Array(160, 80, 120)(InStr("ABC", Left(Cells(i, "A").Value, 1)) - 1)
iC = iC + 1
iw1 = iw1 - Cells(i - 1, iC)
End If
iw2 = Cells(i, "B").Value
If iw2 <= iw1 Then
Cells(i, iC).Value = iw2
Else
Cells(i, iC).Value = iw1
Cells(i, iC + 1).Value = iw2 - iw1
End If
iw1 = iw1 - iw2
Next i
End Sub
ただし、A222からB111に切り替わるあたりで、ご指定と異なる結果になります。
これは、Aとして詰め始めるので、箱としては160を用意するので、C222まで全部収まってしまうから。
この解釈のほうが正しいように思いますが、いかがでしょうか？
（???） 2016/05/19(木) 17:32
前回に続きありがとうございます。
最後の箱とは異なる新しい箱（１つ右の列）に詰めたほうがいいのでは？
→確かにそうですよね。マクロで組んだ際にこのように表示されるようになったらうれしいな-と思いこのような書き方をしてしまいました。
男性なのか女性なのかわかりませんが、すぐに回答して頂き、また知識があることでかっこよく思え惚れてしまいそうです。
私のような若輩者に対して親切な回答ありがとうございました^^
（ＱＰちゃん） 2016/05/20(金) 16:09
ありがとうございます。
箱のサイズが一つしかなく、物が３モデルあります。
私の説明に間違いがありましたね。
1つの箱に
イチゴが160個、トマトが120個、グレープフルーツが80個入る感じです。
箱としては160を用意するので、C222まで全部収まってしまうから。
この解釈のほうが正しいように思いますが、いかがでしょうか？
→箱としてイチゴが160個入る物を用意してしまうと、グレープフルーツが入らなくなってしまいます。
私の説明が下手ですみませんでした。
もしよろしければ、小さいもの順で組んでいただけますでしょうか？
また下記のような意味も添えていただけると助かります。（’←ココの部分）
Dim r As Long
r = 6
Do While Range("A" & r).Value <> "" 'A4から空白になるまで繰り返し処理
If Range("E" & r).Value = "" Then 'E4が空白なら
Range("E" & r).Value = "=SUM(" & Range("F" & r).Address & ":" & Range("U" & r).Address & ")" 'E6に=SUM(" & Range("F" & r).Address & ":" & Range("U" & r).Address & ")" を入力
End If
r = r + 1 ' rの値 + 1
Loop '繰り返し処理
（ＱＰちゃん） 2016/05/20(金) 16:20
ABCのサイズ：3,6,4
箱のサイズ：480
このように仮定し、手直ししてみます。
Sub test()
Dim i As Long
Dim iC As Long
Dim i1 As Long
Dim iw1 As Long
Dim iw2 As Long
iC = 4
For i = 2 To Cells(Rows.Count, "C").End(xlUp).Row
If iw1 <= 0 Then
iw1 = 480
iC = iC + 1
If 2 < i Then
i1 = Array(3, 6, 4)(InStr("ABC", Left(Cells(i - 1, "C").Value, 1)) - 1)
iw1 = iw1 - Cells(i - 1, iC) * i1
End If
End If
i1 = Array(3, 6, 4)(InStr("ABC", Left(Cells(i, "C").Value, 1)) - 1)
iw2 = Cells(i, "D").Value * i1
If iw2 <= iw1 Then
Cells(i, iC).Value = iw2 / i1
Else
Cells(i, iC).Value = iw1 / i1
Cells(i, iC + 1).Value = (iw2 - iw1) / i1
End If
iw1 = iw1 - iw2
Next i
End Sub
なお、コメントの追加は、私は行いません。これは貴方の仕事であり、私はちょっと手助けしただけです。
今後の変更はご自身で行って頂くため、まずはどういう考えなのか、命令を調べながら理解してください。
私がコメントを書いてしまうと、ふーん、そうなんだ、となり、理解したつもり、で終わってしまいます。
ロジックを追いかけてみて、命令を調べてみて、どうしても理解できない箇所があれば、個別に聞いてください。
(18:18 元データがC,D列というのを見落としていたので、修正)
（???） 2016/05/20(金) 18:18
※お礼が遅くなってしまいすみません。
月末の出荷量が多くてパソコンを触れる環境でなかったです。申し訳ありません。
ありがとうございます。
確かに、コメントの追加をしていただくとそれまでで終わってしまいますね。
作成して頂いたマクロで編集してみても、型が一致しません。と出てしまいました。
それは、私がやりたいマクロの説明を端折ってしまっているからです。。
もう一度、新規で端折らず質問する予定ですので、宜しければおつきあい頂けますでしょうか。
宜しくおねがいします。
（QPちゃん） 2016/06/01(水) 16:59
なんとなく想像できる問題は、実はABCの3種類ではないのでこれを増やしたけれど、Arrayの数値は増やさなかった、とか？
（???） 2016/06/01(水) 18:19
こんばんわ。
回答ではありません。 一つだけ気になったので質問です。
Qtyの値が箱のサイズより多くなる事は無いんですか？ 例えばA111のQtyが500個とかになる事は無いのでしょうか？
無ければ、無視して下さい。
（sy） 2016/06/01(水) 20:17
こんにちは。
実際はABCの三種類ではないのですが、作成して頂いたマクロで作動するのか試したく三種類のみにして実行してみました。
マクロ自体ぺーぺーでちんぷんかんぷんな私からすると
ABCのサイズ：3,6,4
箱のサイズ：480
と、仮定していただいて、実務をしている側としては「箱にたいして入る物のサイズが80/120/160だし、これならいける！！」と、思えました。
ちなみに黄色くエラーが出たところは下記です。
iw2 = Cells(i, "D").Value * i1
MODEがABCではなく、
実際は
MODEL 1箱あたりに入る最大数
701020000 80
701020040 80
701110200 80
701110300 80
701110400 80
74304 80
74307 80
74503 120
74504 120
74002 120
74106 120
74111 120
74507 120
74701 160
74704 160
です。くどく書くと判りづらくなってしまうからABCにしておこう。と、してしまいました。。
出荷業務がキリがつくのが夕方になってしまうため、返信は夕方ごろになってしまいすみません。
（QPちゃん） 2016/06/02(木) 18:01
こんにちは。
Qtyの値が箱のサイズより多くなる事は無いんですか？
例えばA111のQtyが500個とかになる事は無いのでしょうか？ ↓ あります。
（QPちゃん） 2016/06/02(木) 18:09
こんばんわ。
例えがまずかったと思います。 皆さん、MODELはABCが含まれる文字と思ってますから、後から提示された実際のMODELは全く仮定が違うので、 かなり書き換えないと対処できないと思います。
MODELは商品コードなんですね。 後からの例みたいなケースでは、ある程度の規則性はあるみたいですけど、今後例に無いパターンが追加されたり、 商品が増えた時などはコードの修正が大変なので、一案です。
下のレイアウトのようなパターン表と対応表を作成して、それらの条件を使って箱詰の数量を求めるようにしてはどうでしょうか？ シート名は仮で、結果を表示するシートが箱詰割当シート、対応表やパターン表のシートを対応表シートとして、
対応表シート(仮)
|[A] |[B] |[C]|[D] |[E]
[1] |パターン|個数/箱| |MODEL |パターン
[2] | 1| 80| |701020000| 1
[3] | 2| 120| |701020040| 1
[4] | 3| 160| |701110200| 1
[5] | | | |701110300| 1
[6] | | | |701110400| 1
[7] | | | | 74304| 1
[8] | | | | 74307| 1
[9] | | | | 74503| 2
[10]| | | | 74504| 2
[11]| | | | 74002| 2
[12]| | | | 74106| 2
[13]| | | | 74111| 2
[14]| | | | 74507| 2
[15]| | | | 74701| 3
[16]| | | | 74704| 3
以下コードです。 私ではあまり機能的で見栄えの良いのは書けないです。すいません。 一応動作的には問題ないはずです。
Sub test()
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("対応表")
'シートクリア
Range("F:F").Resize(, Columns.Count - 5).ClearContents
'箱の容量計算
base = WorksheetFunction.Lcm(sh2.Range("B2", sh2.Range("B" & Rows.Count).End(xlUp)))
capa = base
'箱詰計算
j = 6
For i = 2 To sh1.Range("C" & Rows.Count).End(xlUp).Row
'1箱あたりの最大数計算
box = WorksheetFunction.VLookup(sh1.Cells(i, "C").Value, sh2.Range("D1").CurrentRegion, 2, 0)
box = WorksheetFunction.VLookup(box, sh2.Range("A1").CurrentRegion, 2, 0)
'パターンごとの比率
ratio = base / box
num = sh1.Cells(i, "D").Value * ratio
Select Case capa - num
'箱容量が個数より多い
Case Is > 0
sh1.Cells(i, j).Value = num / ratio
capa = capa - num
'箱容量と個数が同数
Case 0
sh1.Cells(i, j).Value = 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 = num - Int(num / base) * box * ratio
End If
j = j + 1
If num = 0 Then
capa = base
Else
sh1.Cells(i, j).Value = num / ratio
capa = base - num
End If
End Select
Next i
Set sh1 = Nothing
Set sh2 = Nothing
End Sub
（sy） 2016/06/03(金) 00:39
MODELの先頭1文字では商品サイズを得られないのならば、「MODEL,Qty」の間に1列挿入して、
「MODEL,Max,Qty」（つまり、結果はF列以降に表示されます）としてみるのはいかがでしょうか？
Maxの列（D列）には、MODEL毎の最大サイズ（160,80,120）を埋めておきます。
これなら、元のロジックをそのまま活かせますし、新しいMODEL追加にも対応が容易です。
ただ、1つのモデル（1行）が1箱に収まらない場合もある、との事なので、jのループを追加しました。
ちょっと複雑になりましたが、iw1が残りの箱サイズで、iw2が1モデルのサイズになる点は変わっていません。
Sub test2()
Const BOXSIZE = 480
Dim i As Long
Dim j As Long
Dim iC As Long
Dim i1 As Long
Dim iw1 As Long
Dim iw2 As Long
Range("F2:" & Range("F2").SpecialCells(xlLastCell).Address).ClearContents
iC = 5
For i = 2 To Cells(Rows.Count, "C").End(xlUp).Row
If iw1 <= 0 Then
iw1 = BOXSIZE
iC = iC + 1
If 2 < i Then
i1 = BOXSIZE / Cells(i - 1, "D").Value
iw1 = iw1 - Cells(i - 1, iC) * i1
End If
End If
i1 = BOXSIZE / Cells(i, "D").Value
iw2 = Cells(i, "E").Value * i1
If iw2 <= iw1 Then
Cells(i, iC).Value = iw2 / i1
iw1 = iw1 - iw2
Else
Cells(i, iC).Value = iw1 / i1
iw2 = iw2 - iw1
For j = 1 To 100
If BOXSIZE < iw2 Then
iC = iC + 1
Cells(i, iC).Value = BOXSIZE / i1
iw2 = iw2 - BOXSIZE
Else
iC = iC + 1
Cells(i, iC).Value = iw2 / i1
Exit For
End If
Next j
iw1 = BOXSIZE - iw2
End If
Next i
End Sub
（???） 2016/06/03(金) 10:06
最大個数列挿入案ですが、一見リスト作成の手間が省けて楽そうに思えたので、私も初め考えたんですが、 でもよくよく考えるとデメリットの方が多いので敢えて避けたので、以下避けた理由を提示しときます。
MODELやパターンの追加対応は、列挿入の方は手間は全くなく、 リストの方は追加する手間が発生するので、列挿入の方が楽ですが、 頻度は年に数回も無いでしょうし、差分追加のデータ量も1件から数件とかでしょうから、 手間と言う程ではないと思います。
対して、
日常業務のデータなので、列を増やすと毎回の入力の手間が2倍に増える。 数日も入力業務を行えば、対応表を作成する手間を超えてしまい、以降は手間が増え続ける。
対応表が無い＝マスターリストが無いと言う事なので、MODELに対応する最大個数を常に把握しておかなければならない。 MODELやパターンの種類が多くなると覚えきれない＝間違いを誘発しやすくなる。
対応表＝マスターリストなので、対応表があれば入力規則で在り得ない値の入力ミスを制限できるが、 マスターリストが無いと、入力ミスを防ぐ方法が無い。
上記のような、デメリットがあります。 特に入力ミスを防げないと言うのは、入力内容の確認作業にも時間が取られるので、 実際の作業以上に手間が膨大に増える事になります。
列の挿入での最大のメリットは自由度が高いと言う事だと思います。 質問者さんの実際の取り扱い製品の寸法が規格が決まっているようなものなら関係ないですが、 果物のように同じものでもサイズが異なるようなものなら、状況に合わせて最大個数を変更する事もあるでしょうから、 そのような時はリストを作って制限をかけてしまうと、自由度が全く無くなるので、最大個数欄があった方が便利ですね。 ただ個数を可変にすると、手計算では160・170・55などの場合、最小公倍数の計算が大変なので、 コード内で計算させて自動で取得するようにした方がメンテナンスフリーになるし良いと思います。
上記のような内容を加味して質問者さんの状況に合わせて、方法に関しては決めれば良いと思います。
（sy） 2016/06/04(土) 15:47
ありがとうございます。
作成していただいたマクロで動作確認できました。
対応表リストを作成しましたが、すべて160で処理されてしまいました。
なぜでしょうか・・・。
念のためもう一度、時間があるときに試してみます。
（QPちゃん） 2016/06/06(月) 12:44
i1 = BOXSIZE / Cells(i - 1, "D").Value が、黄色くなってしまいました。
私のやりたいことの説明がきちんと伝えれていないんだと思います。すみません。
今日の出荷業務が少ないので本日中に端折らず質問したいと思います。
今までは手動で作業してたのでひどいと一日に2時間以上かかって、しかも入力ミスすることもあります。
大変恐縮ですが、完成までおつきあいして頂けますでしょうか。
本来であればすでに作動するはずですが、私の説明力が足らない為、きちんと動いてくれませんでした。
申し訳ありません。
マクロを組むにあたって不要な事も書いてしまうかもしれませんが、宜しくおねがいします。
そのために、私は早めにやりたいことを質問します。
きっと、夕方以降には纏めれると思います。
宜しくおねがいします。
（QPちゃん） 2016/06/06(月) 13:21
元データの i 行目を処理するのですが、そのD列には、160/80/120のいずれかの値が入っているでしょうか？
元データ全てのD列に、このどれかが入っている必要があります。
（???） 2016/06/06(月) 13:31
i1=0
でした。
D列にはD6から最終行まで160.120を入れてあります。
（QPちゃん） 2016/06/06(月) 14:21
で、気になったのはD6から…、という点。私のミスですね。6行目からというのを見逃しました。
i のループが2からになっていますが、これを6からに変えてください。
（???） 2016/06/06(月) 14:44
6に変えたところ、動作確認できました。
160まで達したら次の列へ移動するようになっているのになぜか
G列 ｜ H列 | I列 ｜ J列 ｜
｜2 ｜ ｜ | ｜
｜16 ｜ ｜ ｜ ｜
｜42 ｜ ｜ ｜ ｜
｜99.33333333 ｜ 160 ｜ 160 ｜141.6666667｜
と、なってしまいました。
G列には余計な数字は入っていません。なぜだかわかりますでしょうか？
（QPちゃん） 2016/06/06(月) 15:28
もともと、整数しか扱わない前提で考えていますので、少数が入る場合には正しく動きません。
箱サイズの前提も、整数の最小公倍数ですしね。
最小公倍数が480では足りなくなるモデルパターンを増やしたのではないですか？ その場合は、480という値を改める必要があります。モデルの種類（160/80/120/???）を全て挙げてみてください。
例えば、150という最大サイズのモデルを増やす場合、箱サイズの仮定は2400に変える事になります。
（???） 2016/06/06(月) 17:16
160だと思い込んでましたが、前の行が120でした。
ただいま、出荷作業が増えてきたため、もしかしたら返信できなくなる可能性があります。
申し訳ありません。
（QPちゃん） 2016/06/06(月) 17:56
こんばんわ。
＞対応表リストを作成しましたが、すべて160で処理されてしまいました。
それは無いと思うんですが？ こちらでは順番や個数などバラバラでも、ちゃんと160と120や80が混在している箱でも、 ちゃんと容量に収まって計算されたんですが？
ですが今再度色々なパターンで検証してみて気付きましたが、今まできれいに0になるような個数で検証してたので、 最後0にならずに僅かに隙間が出来る時の組み合わせの時に、最後の個数が小数表示になってました。 申し訳ありません。
それとよくよく考えたらレイアウトも対応表は必要ですが、パターン表は必要ありませんでした。 こちらも重ねて申し訳ありません。
最後僅かな隙間が出来る時に切り捨てるコードに変更しました。 二度手間かけさせて申し訳ありませんがレイアウトも以下の対応表のみの表に変えて実行してみて下さい。
此方で検証した表を提示します。
対応表シート
|[A] |[B]
[1] |MODEL |最大個数
[2] |701020000| 80
[3] |701020040| 80
[4] |701110200| 80
[5] |701110300| 80
[6] |701110400| 80
[7] | 74304| 80
[8] | 74307| 80
[9] | 74503| 120
[10]| 74504| 120
[11]| 74002| 120
[12]| 74106| 120
[13]| 74111| 120
[14]| 74507| 120
[15]| 74701| 160
[16]| 74704| 160
箱詰割当シート(B列の最大個数は分かり易くする為に表示してるだけで、実際は必要ありません)
|[A]|[B] |[C] |[D]|[E]|[F]|[G]|[H]|[I]|[J]|[K]|[L]|[M]|[N]|[O]|[P]|[Q]|[R]
[5] | |最大個数|MODEL |Qty| | | | | | | | | | | | | |
[6] | | 120| 74507| 64| | 64| | | | | | | | | | | |
[7] | | 160| 74704| 28| | 28| | | | | | | | | | | |
[8] | | 80|701020000| 47| | 23| 24| | | | | | | | | | |
[9] | | 160| 74704| 23| | | 23| | | | | | | | | | |
[10]| | 160| 74704| 36| | | 36| | | | | | | | | | |
[11]| | 80|701020000|437| | | 26| 80| 80| 80| 80| 80| 11| | | | |
[12]| | 80|701020000| 80| | | | | | | | | 69| 11| | | |
[13]| | 80|701020000| 99| | | | | | | | | | 69| 30| | |
[14]| | 80|701020000| 56| | | | | | | | | | | 50| 6| |
[15]| | 120| 74507|100| | | | | | | | | | | |100| |
[16]| | 80|701020000| 65| | | | | | | | | | | | 7| 58|
[17]| | 120| 74507| 10| | | | | | | | | | | | | 10|
[18]| | 80|701020000| 10| | | | | | | | | | | | | 10|
[19]| | 120| 74507| 28| | | | | | | | | | | | | 8| 20
[20]| | 120| 74507| 16| | | | | | | | | | | | | | 16
[21]| | 120| 74507| 18| | | | | | | | | | | | | | 18
以下修正版コードです。
Sub test()
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("対応表")
'シートクリア
Range("F:F").Resize(, Columns.Count - 5).ClearContents
'箱の容量計算
base = WorksheetFunction.Lcm(sh2.Range("B2", sh2.Range("B" & Rows.Count).End(xlUp)))
capa = base
'箱詰計算
j = 6
For i = 6 To sh1.Range("C" & Rows.Count).End(xlUp).Row
'1箱あたりの最大数計算
box = WorksheetFunction.VLookup(sh1.Cells(i, "C").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
Set sh1 = Nothing
Set sh2 = Nothing
End Sub
すいません。 6行目スタートを見逃してたので、レイアウトとコードを6行目からに変更しました。（22：19）
（sy） 2016/06/06(月) 20:45
おはようございます。
こちらは最小公倍数を求めず、箱を1として計算するコードです。 どちらも結果は同じですが、コードはこちらの方がすっきりしています。
Sub test2()
Dim i As Long, j As Integer
Dim sh1 As Worksheet, sh2 As Worksheet
Dim box As Double, num As Integer, Qty As Integer
'変数宣言
Set sh1 = Sheets("箱詰割当")
Set sh2 = Sheets("対応表")
'シートクリア
Range("F:F").Resize(, Columns.Count - 5).ClearContents
'箱詰計算
box = 1
j = 6
For i = 6 To sh1.Range("C" & Rows.Count).End(xlUp).Row
'最大個数
num = WorksheetFunction.VLookup(sh1.Cells(i, "C").Value, sh2.Range("A:B"), 2, 0)
'Qty
Qty = sh1.Cells(i, "D").Value
Select Case box - Qty / num
'箱容量が個数より多い
Case Is > 0
sh1.Cells(i, j).Value = Qty
box = box - Qty / num
'箱容量と個数が同数
Case 0
sh1.Cells(i, j).Value = Qty
box = 1
j = j + 1
'箱容量より個数が多い
Case Else
sh1.Cells(i, j).Value = Int(box * num)
If (Qty - Int(box * num)) / num >= 1 Then
sh1.Cells(i, j + 1).Resize(, Int((Qty - Int(box * num)) / num)).Value = num
j = j + Int((Qty - Int(box * num)) / num)
End If
j = j + 1
If Qty Mod num - Int(box * num) Mod num = 0 Then
box = 1
Else
sh1.Cells(i, j).Value = Qty - WorksheetFunction.Sum(sh1.Cells(i, "F").Resize(, j))
box = 1 - sh1.Cells(i, j).Value / num
End If
End Select
Next i
Set sh1 = Nothing
Set sh2 = Nothing
End Sub
（sy） 2016/06/07(火) 07:20
すいません。 ちょっと間抜けでした。
シートクリアの一行、シート装飾のsh1.が抜けてました。
（sy） 2016/06/07(火) 10:41
こんにちわ。
box = WorksheetFunction.VLookup(sh1.Cells(i, "C").Value, sh2.Range("A:B"), 2, 0)
が、黄色くなってしまいました。
黄色のところにカーソルを合わせたら「box=0」と出ています。
これは正しいですか？
（QPちゃん） 2016/06/07(火) 13:04
VLOOKUP関数なので検索値が存在しないとエラーになるので 対応表に存在しないMODELで検索してる事は無いですか？ 末尾にスペースが入ってるとかは無いですか？
（sy） 2016/06/07(火) 15:19
sh1.Cells(i, "C").Value のiの行のMODELを調べてみて下さい。
（sy） 2016/06/07(火) 15:24
後もう一つ考えられる可能性は、 見た目は同じでも、どちらかのMODELが文字データになっていて、片方が数値データの場合なども、VLOOKUPではエラーになります。 何れにしてもMODELのデータの方に問題がある可能性が一番高いです。
（sy） 2016/06/07(火) 21:14
おはようございます。
何度もすいません。
もしかしたら修正コードではパターン表を削除して、AB列に対応表があるとしてAB列で検索してるので、 シート構成を以下のように変更しないと検索で見つからないのでエラーになります。
もしもそれが原因でしたら、途中で参照先を変更して申し訳ないですが、下のように、 A列にMODEL、B列に最大個数の表にして下さい。
対応表シート
|[A] |[B]
[1] |MODEL |最大個数
[2] |701020000| 80
[3] |701020040| 80
[4] |701110200| 80
（sy） 2016/06/08(水) 07:05
こんにちわ。
MODEL列に品目コードが入っていますが、すべてセルの左上に緑色の三角が付いています。
手入力で品目コードを打ち直したところ、緑色の三角は消えて
その後、ボタンを押したらマクロの動作確認ができました。
緑色の三角は、文字列や標準や数値に変えても消えませんでした。
緑の三角を一気に消す方法はご存じでしょうか？
（QPちゃん） 2016/06/08(水) 13:19
一度入力された値はその書式を変更してもデータの種別（数値や文字）は変わらない。
>入力で品目コードを打ち直したところ、緑色の三角は消えて
ということであればその列を選択してデータ-区切り位置を開き、すぐに完了を選択してはどうか？
なお、緑三角が表示されているセルを選択した際に◇で囲まれた！マークが表示されるがこのマークを選択すると なぜ表示されているかの説明が出る。
たぶん「このセルにある数値が、テキスト形式か、またはアポストロフィで始まっています」だと思うが。 （ねむねむ） 2016/06/08(水) 13:35
こんばんわ。
緑の三角の件は、ねむねむさんのアドバイス通りだと思います。
test2のコードですが、コードはすっきりしてて良いんですが、小数を扱うのでEXCELの演算誤差の問題がありました。 演算誤差が発生するのは、箱容量より個数が多い時、に発生します。 申し訳ありません。 以下修正コードです。 testの方は小数を扱わないので演算誤差はありません。
Sub test2()
Dim i As Long, j As Integer
Dim sh1 As Worksheet, sh2 As Worksheet
Dim box As Double, num As Integer, Qty As Integer, Val As Integer
'変数宣言
Set sh1 = Sheets("箱詰割当")
Set sh2 = Sheets("対応表")
'シートクリア
sh1.Range("F:F").Resize(, Columns.Count - 5).ClearContents
'箱詰計算
box = 1
j = 6
For i = 6 To sh1.Range("C" & Rows.Count).End(xlUp).Row
'最大個数
num = WorksheetFunction.VLookup(sh1.Cells(i, "C").Value, sh2.Range("A:B"), 2, 0)
'Qty
Qty = sh1.Cells(i, "D").Value
Select Case box - Qty / num
'箱容量が個数より多い
Case Is > 0
sh1.Cells(i, j).Value = Qty
box = box - Qty / num
'箱容量と個数が同数
Case 0
sh1.Cells(i, j).Value = Qty
box = 1
j = j + 1
'箱容量より個数が多い
Case Else
Val = Int(WorksheetFunction.Round(box * num, 12))
sh1.Cells(i, j).Value = Val
If Qty - Val >= num Then
sh1.Cells(i, j + 1).Resize(, Int((Qty - Val) / num)).Value = num
j = j + Int((Qty - Val) / num)
End If
j = j + 1
If Qty = Val Then
box = 1
Else
sh1.Cells(i, j).Value = Qty - WorksheetFunction.Sum(sh1.Cells(i, "F").Resize(, j))
box = 1 - sh1.Cells(i, j).Value / num
End If
End Select
Next i
Set sh1 = Nothing
Set sh2 = Nothing
End Sub
（sy） 2016/06/08(水) 20:12
こんにちわ。
ありがとうございます。
緑三角が消えました！
（QPちゃん） 2016/06/09(木) 14:17
こんにちわ。
おしえていただいたマクロの前後に罫線を入れたり、関数をいれたりして完成させてみようと思います。
ずうずうしいですが、また力をお借りするかもしれません。
長い間ありがとうございました！
（QPちゃん） 2016/06/09(木) 14:41
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.