【ノーコード】VBAコードを作成する無料アプリ

AIで自分の価値を高める方法とは🙄

MENU

【ノーコードVBA】在庫表、受注表から、在庫引当表を作成する

エクセルVBAマクロを自動作成する無料アプリです。

例として「在庫表、受注表から、在庫引当表を作成する」VBAマクロを作成します。

事例1 一つの製品の在庫引当表をつくる

 



アプリの設定

アプリの設定です。

アプリへのリンク
 ⇒【ツール】在庫引当



表示される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

 

事例2 複数製品の在庫引当表をつくる

 

アプリの設定

アプリの設定です。

アプリへのリンク
 ⇒【ツール】在庫引当

 

事例3 コメントを表示する

 

 受注表の下部にある「未納品あり」のコメントの関数は、
  =IF(AND(G3<>"",COUNT(F3:F13)<>COUNT(G3:G13)),"未納品あり","")
・G3<>""
で引当前にメッセージが出ないようにします。
・COUNT(F3:F13)<>COUNT(G3:G13))で、範囲にある値の数が異なったときメッセージを表示します。

 引当表の下部にある「部分納品あり」のコメントの関数は、
  =IF(J14<>L14,"部分納品あり","")

 



ChatGPTで修正

コードの改変は、無料で使えるマイクロソフトの「BingAIチャット」を使います。
とても簡単です!

アプリはこちらから↓↓↓↓