【社内DX案件紹介】封入物の重さによって印刷会社を変える

 コスト削減において、もっとも大きいな削減は人件費となりますが、通常の業務を少しDXすることでコスト削減を図ることが可能です。

■社内DXの依頼内容

お客様に送る郵送物を、封入物の重さによって印刷会社１・２・３に分類しコスト削減を図りたい。

■社内DXの条件

・封入物はA～Eの５種類

　封入物A：2g

　封入物B：3g

　封入物C：5g

　封入物D：10g

　封入物E：15g

・郵送物の重さによって印刷会社を変える

　15g未満：印刷会社１

　35g未満：印刷会社２

　35g以上：印刷会社３

・リストは横方向に順不同で封入物が記載されている

■諸元

・封入物のリストから重さを検索する

・検索には連想配列（Dictionaryオブジェクト）を使用して検索を高速化する

・封入物の総重量によって印刷会社を１～３で設定

■作成方法

１．シート「リスト」に顧客情報と封入物のリストを用意（今回は項番1～100でセット）

２．シート「封入物リスト」に封入物名と重さのリストを用意

３．実際にマクロを書いていく

Sub Insatsu_List()
    Dim y As Long           '/--行周回用のカウンタ--/'
    Dim x As Integer        '/--列周回用のカウンタ--/'
    
    Dim dicFunyu As Object  '/--封入物の連想配列用オブジェクト--/'
    Dim strKey As String    '/--検索用キー格納--/'
    Dim lngOmosa As Long    '/--重さを格納--/'
    Dim strKaisha As String '/--印刷会社名--/'
    
    '/--オブジェクトを連想配列（Dictionary）としてセット--/'
    Set dicFunyu = CreateObject("Scripting.Dictionary")
    
    '/--連想配列作成--/'
    For y = 2 To 6
        strKey = Sheets("封入物リスト").Cells(y, 1).Value
        lngOmosa = Sheets("封入物リスト").Cells(y, 2).Value
        '/--連想配列に検索キー（strKey）と値（lngOmosa）を格納--/'
        dicFunyu.Add strKey, lngOmosa
    Next y
    
    '/--リスト内のデータに重さ、印刷会社を記入--/'
    For y = 2 To 101
        lngOmosa = 0
        For x = 3 To 7
            strKey = Sheets("リスト").Cells(y, x).Value
            lngOmosa = lngOmosa + dicFunyu.Item(strKey)
        Next x
        
        Sheets("リスト").Cells(y, 8) = lngOmosa
        
        Select Case lngOmosa
            Case Is < 15
                strKaisha = "１"
            Case Is < 35
                strKaisha = "２"
            Case Is >= 35
                strKaisha = "３"
        End Select
        
        Sheets("リスト").Cells(y, 9) = strKaisha
        
    Next y
    
    Set dicOmosa = Nothing
    
    
End Sub

■マクロ解説

１．連想配列の作成

    '/--オブジェクトを連想配列（Dictionary）としてセット--/'
    Set dicFunyu = CreateObject("Scripting.Dictionary")
    
    '/--連想配列作成--/'
    For y = 2 To 6
        strKey = Sheets("封入物リスト").Cells(y, 1).Value
        lngOmosa = Sheets("封入物リスト").Cells(y, 2).Value
        '/--連想配列に検索キー（strKey）と値（lngOmosa）を格納--/'
        dicFunyu.Add strKey, lngOmosa
    Next y

・Set dicFunyu = CreateObject("Scripting.Dictionary")

dicFunyuというオブジェクトをDictionaryとしてセットします。

※Officeの365とか、なぜか旧Verと参照設定が異なる場合があるので、基本参照設定を使わないで作成しています

・dicFunyu.Add strKey, lngOmosa

連想配列に検索キー（strKey）と値（lngOmosa）を代入します。

ルールとしては必ず検索キー１に対して値１となること。

Excel関数のVlookupとかみたいに検索キー1つに対して複数の値をとることはできません。

※アイデア次第でやる方法はいくつかありますが別の機会に。

２．重さの取得

            strKey = Sheets("リスト").Cells(y, x).Value
            lngOmosa = lngOmosa + dicFunyu.Item(strKey)

・strKey = Sheets("リスト").Cells(y, x).Value

strKey に封入物名を代入します。

・lngOmosa = lngOmosa + dicFunyu.Item(strKey)

検索キー（strKey）からItem（値）を取り出します。

いかがでしょうか。

このように、少しのアイデアで十分に社内DXが実現できるようになります。

↓よろしければクリックをお願いします！

TOPページへ戻る

■社内DX案件紹介

【社内DX案件紹介】アンケートの集計-１-

【社内DX案件紹介】アンケートの集計-２-

【社内DX案件紹介】架電内容ごとの情報振り分け-1-

【社内DX案件紹介】架電内容ごとの情報振り分け-2-

【社内DX案件紹介】2つのファイルの内容を比較する

【社内DX案件紹介】データの期間によってレコードを分割しファイル出力する

【社内DX案件紹介】値の入っているシートのみ印刷する

■社内DXの進め方

【社内DXの進め方】ブログの目的（会社が求めるDX）

【社内DXの進め方】社内DXの推進について

【社内DXの進め方】社内DXは具体的に何をすればよいのか？

【社内DXの進め方】なぜ今Excelか？