返品書誌データを出版社別に振り分けた出版社シートの作成

syosikakoueyecatcha

Webから入手した書誌データを出版社毎に区分けして、出版社名別にシートを新規作成した上で、返品データを振り分けていきます。
重複なしデータ作成などのVBAを組み立てます。

こんにちは、じゅんぱ店長（@junpa33）です。

今回は,返品了解書作成ソフト作りの中で、

Webから入手した「抽出データ」シートに転記されている書誌データを、重複なしで整理整頓して、出版社名毎のシートに仕分けされるプログラムを作成します。

抽出した書誌データを返品了解書のテンプレートへ転記するための準備作業の前半部分になります。

先回の返品了解書作成記事はこちら↓からお読みいただけます。

henwebdaeyecatcha Webの書誌情報を利用して返品了解書を作成する

返品了解書の今回作成する作業工程

syosisyorip006

先回の記事では、「書誌データ貼付」シートを作成し、Webからの書誌情報を利用するVBAを作成しました。

そして、その結果を「抽出データ」シートに送りました。

今回はその送られた書誌データを出版社毎に仕分けする作業を行います。

  1. 　「出版社リスト」シートに返品了解を依頼する出版社名を取り出します。
  2. 　その依頼する出版社毎に出版社名のＳｈｅｅｔを新しく作成します。
  3. 　出版社名のシートにそれぞれの返品書誌データを仕分けしていきます。
目次へ戻る

「抽出データ」から「出版社名シート」までのVBA

syosisyorip007

この作業用に新たな標準モジュールを挿入追加します。

（挿入の方法はこちら↓で確認できます。）
「ＶＢＥ（ビジュアルベーシックエディター）を起動する」

参考記事

vbavbekidoeyecatch VBA初めての起動。VBEの立ち上げ、保存と終了

「出版社リスト」シートへ出版社名を記述します

「抽出データ」シートに取り出した書誌データは、Webからの書誌情報の取り入れた順番通りにリスト化されています。

出版社くくりにまとめようとした時には、同じ出版社で何冊かあったりと、重複した出版社名を整理する必要があります。

「出版社」シートには、重複しない出版社名がデータとしてリストアップされている必要があります。

そのリストアップにはVBAで”Dictionaryオブジェクト”を使って重複チェックを行うのが簡潔です。

vbajyufukueyecatch エクセルVBA 同じ項目をまとめる（重複データの整理）コード作成

Dictionaryオブジェクトを使う準備作業として「参照設定」からランタイムの参照が出来るようにします。

＜参照設定で「Microsoft Scripting Runtime」を導入＞

「ツール」から「参照設定…」をクリックします。

syosisyori001a

「参照設定ーVBAProject」ウインドウで、「Microsoft Scripting Runtime」を選択し「ＯＫ」をクリックしてください。

優先順位「上矢印」を繰って上位に上げておきましょう。

syosisyori002a

プロシージャー名は「出版社名リストアップ」としてください。

VBA
Sub 出版社名リストアップ()
・・・・
End Sub

変数の宣言

「Dictionaryオブジェクト」を宣言します。

「Dictionaryオブジェクト」・・・・・myDic

「出版社名」・・・・・SyuN

コード化するとこのようになります。

VBA
'変数宣言
    Dim s As Long
    Dim t As Long
    Dim tyuRow  As Long
    Dim SyuN As Variant
    Dim myDic As Dictionary
    Set myDic = New Dictionary

出版社リストシートへ出版社名を送る

重複チェックをしながら出版社名データを送るコードは

このようになります。

vbalastcelleyecatch データ入力済セルの最終行番号を取得する fornextirekoeyecatch For～Nextのループと入れ子構造をVBA最速理解
VBA
'出版社名を送る
        Worksheets("抽出データ").Select
          Aho = Worksheets("抽出データ").Range("C2").Value
          tyuRow = Cells(Rows.Count, 2).End(xlUp).Row
          For s = 1 To tyuRow
            SyuN = Cells(s, 3).Value
            If myDic.Exists(SyuN) = False Then
               myDic.Add SyuN, ""
            End If
          Next s
        Worksheets("出版社リスト").Select
          For t = 1 To myDic.Count - 1
            Cells(t, 1).Value = myDic.Keys(t)
          Next t

出版社別に新しく出版社名シートを作成します

新たにプロシージャー名を「出版社シート」として追加します。

vbanameeyecatch 新規作成ブックとシート。アクティブ状態でやっておくこと
VBA
Sub 出版社シート()
    Dim SyuRow As Long
    Dim SN As Variant
    Dim t As Long
        Worksheets("出版社リスト").Select
          SyuRow = Cells(Rows.Count, 1).End(xlUp).Row
          For t = 1 To SyuRow
            SN = Range("A" & t).Value
            Worksheets.Add After:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = SN
            Worksheets("出版社リスト").Select
         Next t
End Sub

シート名を付ける場合、

先に、必要な数のシートを作ってから後で一つづつ名前付けをするよりも

新たなシートを作るときに、同時に名前を付けて行くというのが一番簡単な方法になります。

出版社名シートに書誌データを振り分けます

「出版社リスト」から一つづつ出版社名を拾って「抽出リスト」から該当データを抜き取り、

それぞれの「出版社シート」に転記していきます。

プロシージャー名を「出版社振り分け」として追加します。

vbacolumnseyecatch Columnsプロパティでセルの列を指定する
VBA
Sub 出版社振り分け()
    Dim SyuRow, tyuRow As Long
    Dim SN As Variant
    Dim s As Long
    Dim t As Long
    Dim n As Long
        Worksheets("出版社リスト").Select
          SyuRow = Cells(Rows.Count, 1).End(xlUp).Row
          For t = 1 To SyuRow
            SN = Range("A" & t).Value
            Worksheets("抽出データ").Select
            tyuRow = Cells(Rows.Count, 3).End(xlUp).Row
            s = 1
            For n = 1 To tyuRow
              If Range("C" & n).Value = SN Then
                Rows(n).Copy Destination:=Worksheets(SN).Range("A" & s)
                s = s + 1
                Worksheets(SN).Columns("A:G").AutoFit
              End If
                Worksheets("抽出データ").Select
            Next n
            Worksheets("出版社リスト").Select
         Next t
End Sub

「返品書誌データ整理」ボタンの設置

「操作ボタン」シートに「返品書誌データ整理」プロシージャーを起動するボタンを設置します。

「返品書誌データ整理」ボタンはここまで作成したVBAプログラムを順に実行するためのボタンです。

エラー処理として、対策のためのコードを埋め込みます。
「抽出データ」が空の時（返品書誌データが抽出されていないとき）はプロシージャーを終了します。

今までに作成したプロシージャーを連続で順番に起動するためのプロシージャーとして、

「返品書誌データ整理」プロシージャーを作成します。

vbacalleyecatch 部品化プロシージャーでCallステートメントは必須 vbabuttoneyecatch コマンドボタンをシートに設置する２つの方法

ボタンの設置方法についてはこちらでも↓確認できます。

データ抽出ボタンを設置する。

VBA
Sub 返品書誌データ整理()
        Worksheets("抽出データ").Select
        R = Cells(Rows.Count, 2).End(xlUp).Row
        If R <= 1 Then
            MsgBox "返品データが取り出されていません！"
            Worksheets("操作ボタン").Select
            Range("A1").Select
            Exit Sub
        End If
        Call Module2.出版社名リストアップ
        Call Module2.出版社シート
        Call Module2.出版社振り分け
End Sub

「操作ボタン」シートでの「返品書誌データ整理」ボタンの設置場所は特に指定はありません。

syosisyori003a
目次へ戻る

今回作成したＶＢＡコード

syosisyorip008
VBA
Option Explicit

Sub 返品書誌データ整理()
Dim R As Long
        Worksheets("抽出データ").Select
        R = Cells(Rows.Count, 2).End(xlUp).Row
        If R <= 1 Then
            MsgBox "返品データが取り出されていません！"
            Worksheets("操作ボタン").Select
            Range("A1").Select
            Exit Sub
        End If
        Call Module2.出版社名リストアップ
        Call Module2.出版社シート
        Call Module2.出版社振り分け
End Sub

Sub 出版社名リストアップ()
'変数宣言
    Dim s As Long
    Dim t As Long
    Dim Aho As Variant
    Dim tyuRow  As Long
    Dim SyuN As Variant
    Dim myDic As Dictionary
    Set myDic = New Dictionary
'出版社名を送る
        Worksheets("抽出データ").Select
          Aho = Worksheets("抽出データ").Range("C2").Value
          tyuRow = Cells(Rows.Count, 2).End(xlUp).Row
          For s = 1 To tyuRow
            SyuN = Cells(s, 3).Value
            If myDic.Exists(SyuN) = False Then
               myDic.Add SyuN, ""
            End If
          Next s
        Worksheets("出版社リスト").Select
          For t = 1 To myDic.Count - 1
            Cells(t, 1).Value = myDic.Keys(t)
          Next t
End Sub

Sub 出版社シート()
    Dim SyuRow As Long
    Dim SN As Variant
    Dim t As Long
        Worksheets("出版社リスト").Select
          SyuRow = Cells(Rows.Count, 1).End(xlUp).Row
          For t = 1 To SyuRow
            SN = Range("A" & t).Value
            Worksheets.Add After:=Worksheets(Worksheets.Count)
            ActiveSheet.Name = SN
            Worksheets("出版社リスト").Select
         Next t
End Sub

Sub 出版社振り分け()
    Dim SyuRow, tyuRow As Long
    Dim SN As Variant
    Dim s As Long
    Dim t As Long
    Dim n As Long
        Worksheets("出版社リスト").Select
          SyuRow = Cells(Rows.Count, 1).End(xlUp).Row
          For t = 1 To SyuRow
            SN = Range("A" & t).Value
            Worksheets("抽出データ").Select
            tyuRow = Cells(Rows.Count, 3).End(xlUp).Row
            s = 1
            For n = 1 To tyuRow
              If Range("C" & n).Value = SN Then
                Rows(n).Copy Destination:=Worksheets(SN).Range("A" & s)
                s = s + 1
                Worksheets(SN).Columns("A:G").AutoFit
              End If
                Worksheets("抽出データ").Select
            Next n
            Worksheets("出版社リスト").Select
         Next t
End Sub
目次へ戻る

抽出データシートからの書誌データ整理まとめ

syosisyorip009

今回は、Webから順不同に入手して「抽出データ」シートに転記された書誌データが、重複なしで整理整頓して、

出版社名毎のシートに仕分けされるところまで行いました。

次回は、新規に設置するエクセルBOOK「返品了解申請.xlsm」へデータを転送するVBAの作成となります。

改訂新版 てっとり早く確実にマスターできるＥｘｃｅｌ ＶＢＡの教科書
定番参考書の改定新版が、動画付きになりもっと分かり易くなった
vbastudy022a
vbastudy023a

電子書籍版「改訂新版 てっとり早く確実にマスターできるＥｘｃｅｌ ＶＢＡの教科書」をamazonで見てみる

（著者）大村あつし
（出版社）技術評論社
（税込価格）2,508円（本体2,280円＋税）

30冊を超えるExcelのマクロやVBAの解説書を執筆してきた著者による考え抜かれた本書の内容と構成。
独創的な解説手法で必ずExcel VBAが理解できます！
初級からの参考書ですが、より実践的切り口での解説をしています。
QRコードから操作の流れを動画（無音です）で確認することもできるようになりました。
文章解説と動画との関係性は、主は文章での解説、サポートが動画になります。
てっとり早く確実にマスターできるＥｘｃｅｌ　ＶＢＡの教科書 改訂新版/技術評論社/大村あつし
posted with カエレバ
楽天市場
Amazon
Yahooショッピング
7net

次の記事を読むのはこちら↓から

datarenkeyecatch データのあるブックから別のエクセルに値を転送するVBA

エクセルVBAを独習するのに参考書は欠かせません。 参考書選びは自分に合った「相棒」にできるものを選んでいきたいです。

vbastudyeyecatch2 エクセルVBAの独習でおすすめ参考書を7冊選ぶ。良書との出会いは大切です

今回の記事はここまでです。   最後までご覧いただき有難うございました。

エクセルVBA最速理解で必要な知識を集めよう！

エクセルVBA業務ツールで日常の業務改善を行いましょう。

＜記事内容についての告知＞

VBAコードの記述記事においては、その記述には細心の注意をしたつもりですが、掲載のVBAコードは動作を保証するものではりません。 あくまでVBAの情報の一例として掲載しています。 掲載のVBAコードのご使用は、自己責任でご判断ください。 万一データ破損等の損害が発生しても当方では責任は負いません。

目次へ戻る

アンケートでポイ活しよう!!

アンケートに答えれば答えるほど ”使える” ポイントがたまります。

NTTコム サーチ

af_banner01

Dstyle web

dstyleweb_logo
dstyle_320x50-min

前の記事

henwebdaeyecatcha
Webの書誌情報を利用して返品了解書を作成する

次の記事

データのあるブックから別のエクセルに値を転送するVBA
datarenkeyecatch