エクセルVBAマクロを自動作成する無料アプリです。
例として「在庫表、受注表から、在庫引当表を作成する」VBAマクロを作成します。
事例１ 一つの製品の在庫引当表をつくる
アプリの設定
アプリの設定です。
アプリのトップページ
⇒▼在庫引当
⇒【ツール】在庫引当
表示されるVBAコード
アプリで作成されたコードを、VBE画面に貼り付ければ、マクロの完成です。
VBAコードを見る
Sub デモ() '在庫引当
Application.ScreenUpdating = False ' 画面描画を停止
Application.DisplayAlerts = False ' 警告表示を停止
Dim セル範囲 As String, セル As Range, 右下セル As String
'◆前回の処理結果をクリア
Worksheets("製品A").Select
If Cells(3, 3).Value <> "" Then Range(Cells(3, 3), Cells(3, 3).End(xlDown)).ClearContents
Worksheets("製品A").Select
If Cells(3, 7).Value <> "" Then Range(Cells(3, 7), Cells(3, 7).End(xlDown)).ClearContents
Worksheets("製品A").Select
If Cells(3, 9).Value <> "" Then Range(Cells(3, 9), Cells(3, 12).End(xlDown)).ClearContents
Dim 在庫行 As Long, 受注行 As Long, 引当行 As Long
Dim 在庫残 As Long, 受注数 As Long, 受注残 As Long
'◆初期値の設定
在庫行 = 3
引当行 = 3
在庫残 = Worksheets("製品A").Cells(在庫行, 2)
'◆上から順に、在庫を受注に引き当てます
For 受注行 = 3 To Worksheets("製品A").Cells(3, 6).End(xlDown).Row
受注残 = Worksheets("製品A").Cells(受注行, 6)
Worksheets("製品A").Cells(引当行, 9) = Worksheets("製品A").Cells(受注行, 5) '受注番号
Worksheets("製品A").Cells(引当行, 10) = Worksheets("製品A").Cells(受注行, 6) '受注数
'◆在庫が受注より少ない場合
If 在庫残 <= 受注残 Then
'◆受注残がゼロになるまで、DoからLoopまでを繰り返します
Do Until 受注残 = 0
Worksheets("製品A").Cells(引当行, 11) = Worksheets("製品A").Cells(在庫行, 1) '製造番号
'◆在庫が受注残より少ないときは、とりあえず現在庫を引き当てて、次の在庫に移ります
If 在庫残 <= 受注残 Then
Worksheets("製品A").Cells(引当行, 12) = 在庫残 '引当数は【在庫残】
Worksheets("製品A").Cells(在庫行, 3) = Worksheets("製品A").Cells(在庫行, 3) + 在庫残 '（在庫欄に引当数を反映）
Worksheets("製品A").Cells(受注行, 7) = Worksheets("製品A").Cells(受注行, 7) + 在庫残 '（受注欄に引当数を反映）
在庫行 = 在庫行 + 1 '次の在庫を使う
If 在庫行 = Worksheets("製品A").Cells(3, 2).End(xlDown).Row + 1 Then Exit For '在庫データ無で終了
在庫残 = Worksheets("製品A").Cells(在庫行, 2)
'◆在庫が受注残より多くなったら、受注残を引き当て（受注残はゼロ）
Else
Worksheets("製品A").Cells(引当行, 12) = 受注残 '引当数は【受注残】
Worksheets("製品A").Cells(在庫行, 3) = Worksheets("製品A").Cells(在庫行, 3) + 受注残 '（在庫欄に引当数に反映）
Worksheets("製品A").Cells(受注行, 7) = Worksheets("製品A").Cells(受注行, 7) + 受注残 '（受注欄に引当数に反映）
在庫残 = 在庫残 - 受注残 '余った在庫残
End If
'◆ 上記のいずれか引当後、受注残を減らし、次の引当行に移動
受注残 = 受注残 - Worksheets("製品A").Cells(引当行, 12)
引当行 = 引当行 + 1
Loop
'◆在庫が受注より多い場合、受注残を引き当て（受注残はゼロ）
Else
Worksheets("製品A").Cells(引当行, 11) = Worksheets("製品A").Cells(在庫行, 1) '製造番号
Worksheets("製品A").Cells(引当行, 12) = 受注残 '引当数は【受注残】
Worksheets("製品A").Cells(在庫行, 3) = Worksheets("製品A").Cells(在庫行, 3) + 受注残 '（在庫欄に引当数に反映）
Worksheets("製品A").Cells(受注行, 7) = Worksheets("製品A").Cells(受注行, 7) + 受注残 '（受注欄に引当数に反映）
在庫残 = 在庫残 - 受注残
引当行 = 引当行 + 1
End If
Next 受注行
Application.DisplayAlerts = True ' 警告表示を再開
Application.ScreenUpdating = True ' 画面描画を再開
End Sub
事例２ 複数製品の在庫引当表をつくる
アプリの設定
アプリの設定です。
アプリのトップページ
⇒▼在庫引当
⇒【ツール】在庫引当
事例３ コメントを表示する
■ 受注表の下部にある「未納品あり」のコメントの関数は、
=IF(AND(G3<>"",COUNT(F3:F13)<>COUNT(G3:G13)),"未納品あり","")
・G3<>""で引当前にメッセージが出ないようにします。
・COUNT(F3:F13)<>COUNT(G3:G13))で、範囲にある値の数が異なったときメッセージを表示します。■ 引当表の下部にある「部分納品あり」のコメントの関数は、
=IF(J14<>L14,"部分納品あり","")
ChatGPTで修正
コードの改変は、無料で使えるマイクロソフトの「BingAIチャット」を使います。
とても簡単です！
