①製品在庫と②梱包単位より、 ③梱包明細を自動作成をExcelで できるような方法ありますで しょうか? Excel初心者でVBAプログラムは存在を知っているだけで使えません。方法があれば教えて

①製品在庫と②梱包単位より、 ③梱包明細を自動作成をExcelで できるような方法ありますで しょうか? Excel初心者でVBAプログラムは存在を知っているだけで使えません。方法があれば教えて 下さい!

画像

Excel105閲覧

ベストアンサー

0

VBAの経験がないという事ですが、VBAでないと困難な内容だと思います。 条件をSheet1に、表示するものはSheet2で添付図のように項目名だけ入力しておいきます。 標準モジュールです。 Sub Sampler() Dim sh1 As Worksheet, sh2 As Worksheet Dim tbl As Variant Dim i As Integer Dim j As Long Dim unit As Long Dim kosu As Long Dim no As Integer Application.ScreenUpdating = False Set sh1 = Worksheets("Sheet1") Set sh2 = Worksheets("Sheet2") 'Sheet2の以前の内容をクリア With sh2 If .Range("A3").Value <> "" Then .Range("A3:D" & .Cells(Rows.Count, 1).End(xlUp).Row).Clear End If End With no = 1 j = 2 With sh1 '単位個数 unit = .Range("A9").Value '在庫を配列に入れる tbl = .Range("A3:C5") kosu = unit For i = 1 To 3 Do Until tbl(i, 3) = 0 j = j + 1 sh2.Range("A" & j).Value = no sh2.Range("B" & j).Value = tbl(i, 1) sh2.Range("C" & j).Value = Application.Min(kosu, tbl(i, 3)) sh2.Range("D" & j).Value = tbl(i, 2) * sh2.Range("C" & j).Value tbl(i, 3) = tbl(i, 3) - sh2.Range("C" & j).Value kosu = kosu - sh2.Range("C" & j).Value If kosu = 0 Then kosu = unit no = no + 1 End If Loop Next i End With 'Sheet2のデータ表示部に罫線をつける With sh2 With .Range("A3:D" & .Cells(Rows.Count, 1).End(xlUp).Row) .Borders.LineStyle = True End With End With Application.ScreenUpdating = True End Sub

画像

その他の回答(1件)

0

作業列を使いますが、最後の表示に配列数式も使います。 (作業列を増やして最後まで普通の数式で返すこともできますが、配列数式を使っても良いでしょう。) また、INDEX関数を使うと行番号・列番号それぞれに同じSMALL関数を使うのを避けて、特殊なINDIRECT関数を使っています。 (本来であれば、パフォーマンスの良いINDEX関数を使うべきです。) 下図にて、 F2 =IF(J1,MIN(J1,C2),IF(MIN(A$8,C2),MIN(A$8,C2))) G2:I2 =IF(MIN($A$8,$C2-SUM($F2:F2)),MIN($A$8,$C2-SUM($F2:F2))) J2 =A$8-LOOKUP(100,F2:I2) F2:J2を下方にコピーします。 A12 =IF(B12="","",CEILING(SUM(C$12:C12)/A$8,1)) B12 配列数式 =IFERROR(INDEX(A$2:A$4,SMALL(IF(ISNUMBER(F$2:I$4),ROW($1:$3)+COLUMN(F:I)/100),ROW(B1))),"") C12 配列数式 =IFERROR(INDIRECT("R"&SUBSTITUTE(SMALL(IF(ISNUMBER(F$2:I$4),ROW($2:$4)*1000+COLUMN(F:I)),ROW(C1)),"00","C"),FALSE),"") A12:C12を下方にコピーします。

画像