【食品製造】製造日報から製品別・ライン別の歩留まり率を計算し、基準を下回る日を色付けする

公開日:2026年10月7日 執筆:Takuya カテゴリ:業種別サンプル

製造日報の投入量・出来高・廃棄量から、日ごとの歩留まり率と製品別・ライン別の期間集計を作り、製品ごとの基準を下回った日を色付けするマクロです。平均の取り方の注意点も解説します。

想定する場面

食品工場では、原料をどれだけ投入して製品がどれだけできたかを示す「歩留まり率」が、原価や品質の重要な指標になります。製造日報は毎日ラインごとに記録されますが、基準を下回った日を見つけたり、月の実績を製品別・ライン別にまとめたりする作業を手で行うと、時間がかかるうえに見落としも起きます。

このマクロは、日報の各行に歩留まり率を計算して書き込み、製品ごとの基準値を下回った行を色付けします。あわせて、製品×ラインの組み合わせごとに、投入量・出来高・廃棄量の合計と歩留まり率を集計します。

データの形(例)

シートと列の構成は説明用の架空のものです。投入量・出来高・廃棄量は同じ単位(kg など)でそろえておきます。

  • 「製造日報」シート:A列 製造日、B列 製品コード、C列 製品名、D列 ライン、E列 投入量、F列 出来高、G列 廃棄量、H列 歩留まり率(マクロが書き込む)
  • 「歩留まり基準」シート:A列 製品コード、B列 基準歩留まり率(0.92 のような小数)
  • 「歩留まり集計」シート:マクロが集計結果を出力する

コード

基準値は製品コードをキーにした Dictionary に読み込みます。基準が登録されていない製品には、仮の基準値(DEFAULT_STD)を使います。集計は製品コードとラインを組み合わせたキーで行い、投入量と出来高をそれぞれ合計してから率を求めます。

Sub YieldCheck()
    Const DEFAULT_STD As Double = 0.9
    Dim ws As Worksheet, stdWs As Worksheet, outWs As Worksheet
    Dim data As Variant, stdData As Variant, rateOut() As Variant, out() As Variant
    Dim std As Object, sumDic As Object, k As Variant, rec As Variant
    Dim lastRow As Long, i As Long, n As Long
    Dim inQty As Double, outQty As Double, waste As Double, rate As Double, stdRate As Double

    Set ws = ThisWorkbook.Worksheets("製造日報")
    Set stdWs = ThisWorkbook.Worksheets("歩留まり基準")
    Set outWs = ThisWorkbook.Worksheets("歩留まり集計")

    ' 製品ごとの基準値を読み込む
    Set std = CreateObject("Scripting.Dictionary")
    lastRow = stdWs.Cells(stdWs.Rows.Count, "A").End(xlUp).Row
    If lastRow >= 2 Then
        stdData = stdWs.Range("A2:B" & lastRow).Value
        For i = 1 To UBound(stdData, 1)
            If IsNumeric(stdData(i, 2)) Then std(CStr(stdData(i, 1))) = CDbl(stdData(i, 2))
        Next i
    End If

    lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
    If lastRow < 2 Then MsgBox "日報データがありません": Exit Sub
    data = ws.Range("A2:G" & lastRow).Value
    ReDim rateOut(1 To UBound(data, 1), 1 To 1)
    ws.Range("A2:H" & lastRow).Interior.ColorIndex = xlNone
    Set sumDic = CreateObject("Scripting.Dictionary")

    For i = 1 To UBound(data, 1)
        If IsNumeric(data(i, 5)) And IsNumeric(data(i, 6)) And IsNumeric(data(i, 7)) Then
            inQty = CDbl(data(i, 5)): outQty = CDbl(data(i, 6)): waste = CDbl(data(i, 7))
        Else
            inQty = 0
        End If

        If inQty > 0 Then
            rate = outQty / inQty
            rateOut(i, 1) = rate
            stdRate = DEFAULT_STD
            If std.Exists(CStr(data(i, 2))) Then stdRate = std(CStr(data(i, 2)))

            k = CStr(data(i, 2)) & vbTab & CStr(data(i, 4))
            If sumDic.Exists(k) Then
                rec = sumDic(k)
            Else
                rec = Array(data(i, 2), data(i, 3), data(i, 4), 0#, 0#, 0#, 0&, stdRate)
            End If
            rec(3) = rec(3) + inQty
            rec(4) = rec(4) + outQty
            rec(5) = rec(5) + waste
            If rate < stdRate Then
                rec(6) = rec(6) + 1
                ws.Range("A" & i + 1 & ":H" & i + 1).Interior.Color = RGB(255, 199, 206)
            End If
            sumDic(k) = rec
        Else
            rateOut(i, 1) = ""                 ' 投入量がない行は計算しない
        End If
    Next i

    ws.Range("H1").Value = "歩留まり率"
    ws.Range("H2:H" & lastRow).Value = rateOut
    ws.Range("H2:H" & lastRow).NumberFormatLocal = "0.0%"

    ' 製品×ラインの集計を出力する
    outWs.Cells.Clear
    outWs.Range("A1:J1").Value = Array("製品コード", "製品名", "ライン", "投入量計", "出来高計", _
        "廃棄量計", "歩留まり率", "基準", "不明ロス率", "基準割れ日数")
    If sumDic.Count = 0 Then Exit Sub
    ReDim out(1 To sumDic.Count, 1 To 10)
    For Each k In sumDic.Keys
        rec = sumDic(k)
        n = n + 1
        out(n, 1) = rec(0): out(n, 2) = rec(1): out(n, 3) = rec(2)
        out(n, 4) = rec(3): out(n, 5) = rec(4): out(n, 6) = rec(5)
        out(n, 7) = rec(4) / rec(3)                       ' 合計どうしで割る
        out(n, 8) = rec(7)
        out(n, 9) = (rec(3) - rec(4) - rec(5)) / rec(3)   ' 出来高にも廃棄にも入らない量
        out(n, 10) = rec(6)
    Next k
    outWs.Range("A2").Resize(n, 10).Value = out
    outWs.Range("G2:I" & n + 1).NumberFormatLocal = "0.0%"
    outWs.Columns("A:J").AutoFit
    MsgBox n & " 件の製品×ラインを集計しました(赤:基準を下回った日)"
End Sub

コードのポイント

期間の歩留まり率は、日ごとの率を平均するのではなく「出来高の合計 ÷ 投入量の合計」で求めています。投入量が少ない日の率も多い日の率も同じ重みで平均すると、試作や段取り替えで少量だけ流した日の影響が大きくなり、実態とずれてしまうためです。

「不明ロス率」は、投入量から出来高と廃棄量を引いた残りの割合です。蒸発や付着など工程上避けられない減少もありますが、この値が急に大きくなった場合は、計量や記録の漏れ、仕掛品の計上漏れを疑うきっかけになります。

歩留まり率の列は、計算結果を配列にまとめて H列だけに一括で書き込んでいます。A〜G列を書き戻さないので、日報の元データに数式が入っていても値に置き換わることはありません。

現場で使うときの注意

投入量と出来高の単位がそろっていないと、率は意味を持ちません。たとえば投入は kg、出来高は個数で記録している製品は、1個あたりの重量を掛けて kg に換算してから計算してください。

基準値は製品やラインの設備、季節による原料の状態などで変わることがあります。基準を下回った日の色付けは「原因を確認する対象」を見つけるための目印として使い、判断は品質管理や製造の担当者の確認に基づいて行ってください。色付けをやり直すため、マクロは毎回 A〜H列の背景色を消してから塗り直します。日報に手作業で色を付けている場合は、別の列でフラグを立てる方法に変更してください。

※シート名・列構成・基準値は説明用の架空の例です。実際の日報の形式に合わせて変更してください。

ほかの記事