Excelで業務の自動化 その６ ＜ Excel構成展開 ＞

■ExcelやAccessに部品表と構成表を持ち、これをExcel構成展開を使い計算する。

　　※SQL文を書き直せば、SQLServer、 ORACLEなどでも活用可能

＜部品表＞　　　　　　　　　　　　　　　　　　＜構成表＞

　　　　

　　　　　　　　　　　　＜部品構成表＞

　　　　

■Excel構成展開

　　・上記のマスタを使い展開する。

　　＜メニュー＞

　　　　

①DB設定ボタン

　　・対象データベースを指定

　　　　　　

②展開ボタン

　　・アイテム　：　展開する部品名を指定

　　・展開　　　：　親から子の展開は１、子から親の展開は２　を指定　

　　・数量　　　：　子部品の使用数を計算する。

＜展開結果＞

　　　

■構成展開コード

 >[構成展開サブ]の部分を構成が終わるまで、自分自身を呼び出して展開します。

ーーーーーーーーーーーーーーーーーーーーーーーーーーーー

Global GL_ROW As Integer

Global GL_NO As Integer

'******************************

'　構成展開

'******************************

Function 構成展開(HinmokuCd, TKBN, CNT, SU)

     Worksheets("構成情報").Activate

     GL_NO = 0

    'シートのセル全範囲をクリア

     If CNT = 3 Then

         'シートのセル全範囲をクリア

         ActiveSheet.Cells.Clear

          'ヘッダーセット

         ActiveSheet.Cells(1, 1).Value = "グループ"

         ActiveSheet.Cells(1, 2).Value = "NO"

         ActiveSheet.Cells(1, 3).Value = "区分"

         ActiveSheet.Cells(1, 4).Value = "部品コード"

         ActiveSheet.Cells(1, 5).Value = "部品名"

         ActiveSheet.Cells(1, 6).Value = "子部品コード"

         ActiveSheet.Cells(1, 7).Value = "子部品名"

         ActiveSheet.Cells(1, 8).Value = "使用数"

         ActiveSheet.Cells(1, 9).Value = "単位"

         ActiveSheet.Cells(1, 10).Value = "数量"

         '出力行設定

         GL_ROW = 2

      Else

         GL_ROW = GL_ROW + 2

     End If

    '指定データセット

     ActiveSheet.Cells(GL_ROW, 1).Value = CNT - 2

     ActiveSheet.Cells(GL_ROW, 2).Value = GL_NO

     ActiveSheet.Cells(GL_ROW, 3).Value = "'1"

     ActiveSheet.Cells(GL_ROW, 4).Value = HinmokuCd

     ActiveSheet.Cells(GL_ROW, 10).Value = Val(SU)

構成展開サブ HinmokuCd, "1", TKBN, CNT - 2, SU

     GoTo Exit_構成展開

Err_構成展開:

     MsgBox Error$ & Chr$(10) & Chr$(13) & " 親品番 マスター等を確認して下さい。"

Exit_構成展開:

End Function

'******************************

'　構成展開サブ

'******************************

Sub 構成展開サブ(HinmokuCd, Lev, TKBN, CNT, SU)

     Dim con As New ADODB.Connection

     Dim rs As New ADODB.Recordset

     Dim USER, SERVER, DB As String

     Dim SQL As String

     Dim W_SU As Double

     Dim W_WARI As Double

     Dim Lev2 As Integer

     On Error GoTo Err_構成展開サブ

    '接続処理

     If connectionString = "" Then ConnectionString_get

     con.Open connectionString

     If GL_NO = 0 Then

        '展開アイテム名称セット

         SQL = "SELECT 部品名 FROM [部品表] WHERE 部品コード ='" & HinmokuCd & "'"

         'EXCEL用SQL変換

         If InStr(Gl_システム, "EXCEL") <> 0 Then SQL = Replace(SQL, "]", "$]")

         'レコードセットの取得

         Set rs = con.Execute(SQL)

         ActiveSheet.Cells(GL_ROW, 5).Value = rs![部品名]

'         ActiveSheet.Cells(GL_ROW, 7).Value = rs![部品名]

         Set rs = Nothing

     End If

     SQL = "SELECT "

     SQL = SQL & "A.部品コード,A.部品名 ,B.子部品コード ,C.部品名 AS 子部品名,A.単位,B.使用数 "

     SQL = SQL & "FROM [部品表] A,[構成表] B,[部品表] C "

     If TKBN = 1 Then

         SQL = SQL & "WHERE A.部品コード = B.部品コード AND B.子部品コード = C.部品コード "

         SQL = SQL & "AND A.部品コード ='" & HinmokuCd & "'"

     Else

         SQL = SQL & "WHERE B.部品コード = A.部品コード AND B.子部品コード = C.部品コード "

         SQL = SQL & "AND B.子部品コード ='" & HinmokuCd & "'"

     End If

     'EXCEL用SQL変換

      If InStr(Gl_システム, "EXCEL") <> 0 Then SQL = Replace(SQL, "]", "$]")

    'レコードセットの取得

     Set rs = con.Execute(SQL)

    '子部品チェック

     'If rs.RecordCount = Null Or rs.RecordCount = 0 Or rs.EOF Then

     If rs.EOF Then

        GoTo Exit_構成展開サブ

     End If

     Lev2 = 0

     Do Until rs.EOF

         '階層別レコード数カウントアップ

         Lev2 = Lev2 + 1

         '書出し行カウントアップ

         GL_ROW = GL_ROW + 1

        GL_NO = GL_NO + 1

         'レコード書出し

         ActiveSheet.Cells(GL_ROW, 1) = CNT

         ActiveSheet.Cells(GL_ROW, 2) = GL_NO

         ActiveSheet.Cells(GL_ROW, 3) = "'" & Lev & "-" & Lev2

         ActiveSheet.Cells(GL_ROW, 4).Value = rs![部品コード]

         ActiveSheet.Cells(GL_ROW, 5).Value = rs![部品名]

         ActiveSheet.Cells(GL_ROW, 6).Value = rs![子部品コード]

         ActiveSheet.Cells(GL_ROW, 7).Value = rs![子部品名]

         ActiveSheet.Cells(GL_ROW, 8).Value = rs![使用数]

         ActiveSheet.Cells(GL_ROW, 9).Value = rs![単位]

         If TKBN = 1 Then

              W_SU = SU * rs![使用数]

            Else

              W_SU = SU / rs![使用数]

         End If

         ActiveSheet.Cells(GL_ROW, 10).Value = W_SU

         '繰返し展開

         If TKBN = 1 Then

             '自分自身を呼び出す再帰処理  

　　　　構成展開サブ rs![子部品コード], Lev & "-" & Lev2, TKBN, CNT, W_SU

          Else

　　　 '自分自身を呼び出す再帰処理 

　　　　構成展開サブ rs![部品コード], Lev & "-" & Lev2, TKBN, CNT, W_SU

         End If

         rs.MoveNext

         DoEvents

     Loop

     GoTo Exit_構成展開サブ

Err_構成展開サブ:

     MsgBox Error$ & Chr$(10) & Chr$(13) & "子品番マスター等を確認して下さい。"

     'MsgBox Err.Description

Exit_構成展開サブ:

     On Error Resume Next

     rs.Close

     Set rs = Nothing

     'Connectionの状態を確認し、クローズ

     If cn.State <> ADODB.adStateClosed Then

         cn.Close

     End If

     Set cn = Nothing

End Sub

■ダウンロードは 　こちらのページ　をご覧ください。