書誌データの重複を削除し、データベースから書名を取り出すVBAコード

sagyousheeteyecatcha

棚卸しに使える書誌の在庫管理表の作成方法についての解説です。
バーコードで読み取った書誌コードを在庫リスト上に書誌名表示させるために、データベースからのマッチングという方法を使います。
書名の手書きを大幅に減らして作業を楽にしていきましょう。

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

 

雑誌と書籍の在庫管理表のソフト作成の中で、今回は前回に続き

「書誌棚卸表.xlsm」の「作業シート」での操作を行うVBAコードの説明です。

 

前の記事の確認をするにはこちら↓から。

雑誌コードとISBNコードを分解加工するVBAコードを組み立てる。棚卸表作成

 

「雑誌と書籍の在庫リスト」の完成形はこの記事↓をご覧ください。

【棚卸し】無料入手!在庫管理の「雑誌と書籍の在庫リスト」DLと取説

 

雑誌と書籍の在庫リスト作成に関連した記事はこちらになります。

「棚卸表作成」の記事一覧を開く

 

書誌データの重複削除とデータベースから書名を取得する

souyosakuborder011a

 

今回はVBAコードをModule2に記述します。

 

「作業シート」において、

  • リスト中にある同じ書誌を整理して1タイトル1表示とします。
  • それぞれの冊数と単価とその合計金額を計算します。(税別で)
  • データベースからそれぞれの書名を検索し表示します。

 

ここがこのエクセルVBAソフトのいわば心臓部分になります。

 

結果表示は、「作業シート」の余白部分に表示するようにします。

 

項目表示と重複削除

 

先頭行に項目を表示します。

E列からJ列まで使用します。

この様な感じです。

コード①

Sub 項目表示()

Worksheets("作業シート").Select
    Range("E1") = "場所"
    Range("F1") = "書誌コード"
    Range("G1") = "書名"
    Range("H1") = "本体価格"
    Range("I1") = "冊数"
    Range("J1") = "合計"

End Sub

 

リスト中の書誌タイトルの重複を削除します。

”Dictionaryオブジェクト”を利用して重複なしリストを作っていきます。

 

MEMO

Dictionaryオブジェクトについてはこの記事を参考にしてください。

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

最終行の取得についてはこちらを参考にしてください。

データ入力済セルの最終行番号を取得するVBAコード

 

コード②

Sub 書誌重複削除()

Dim Krow As Long
Dim i As Long, j As Long
Dim myKeys As Variant, myItems As Variant
Dim Dic As Object
    Range("F:F").NumberFormatLocal = "@"
    Set Dic = CreateObject("Scripting.Dictionary")

    Krow = Cells(Rows.Count, 2).End(xlUp).Row
    For i = 2 To Krow
        On Error Resume Next
        Dic.Add Worksheets("作業シート").Cells(i, 1).Value, ActiveSheet.Cells(i, 2).Value
    Next i

    For j = 0 To Dic.Count - 1
        myKeys = Dic.keys
        myItems = Dic.Items

        Range("F" & j + 2).Value = myKeys(j)
        Range("H" & j + 2).Value = myItems(j)
    Next j
    With Range("F:H")
        .EntireColumn.AutoFit
    End With
 Set Dic = Nothing
End Sub

 

合計金額の計算と表示

 

ここの部分は、数量と単価から合計金額を計算します。

単価は本体価格(税抜き価格)の表示ですので、合計金額も税抜き価格で表示しています。

 

MEMO

Match関数についてはこちらを参考にしてください。

エクセルVBAで使うMatch関数 活用度アップでテッパン関数に!

 

コード③

Sub 冊数合計マッチ()

Dim Mr As Long
Dim m As Long

frow = Cells(Rows.Count, 6).End(xlUp).Row

For m = 1 To frow
    On Error Resume Next
    Mr = WorksheetFunction.Match(Range("F" & m), Range("A:A"), 0)
    Range("I" & m).Value = Range("C" & Mr).Value
    Range("J" & m).Value = Range("H" & m).Value * Range("I" & m).Value
    If Range("F" & m) = "" Then
        Range("H" & m, "J" & m) = ""
    End If
Next m

With Range("I:I")
    .NumberFormatLocal = "0_"
    .EntireColumn.AutoFit
End With
With Range("J:J")
    .NumberFormatLocal = "\#,##0;\-#,##0"
    .EntireColumn.AutoFit
End With

End Sub

 

データベースから書名をマッチング

 

ここでのVBAコード組み立てのお約束

MEMO
  • データベースを収納しているフォルダー名は「書誌データベース」となっています。このフォルダー名は固定(変更不可)です。
  • フォルダー名を変更する場合は必ずVBAコード上でも変更修正する必要があります。
  • データベース名は自由です。ただしファイル形式はエクセルまたはCSVファイルに限ります。
  • データベースの内容は、「Sheet1」名のシートに記述する必要があります。
  • データベースのレイアウトは、「D列に書誌コード」、「I列に書誌名」を指定しています。それ以外は特に固定事項はありません。自由です。

書誌名挿入 プロシージャー

 

データベースとなるファイルを開いて雑誌コードやISBNコードから書誌名を探します。

このプロシージャーでは、ファイルを開くためのダイアログボックスを表示して、

開くファイルを指定する用のプログラムになります。

データベースを収納しているフォルダー名は「書誌データベース」となっています。このフォルダー名は固定(変更不可)です。

フォルダー名を変更する場合は必ずVBAコードも変更修正する必要があります。

ファイルを開いた後は別のプロシージャー「書誌チェック」を呼び出して書誌名検索に移ります。

そのファイルでの検索が終了したら、次に別のファイルを開くかどうか聞いてきますので、

「はい」か「いいえ」で応答します。

 

 

MEMO

保存先フォルダをダイアログで開く方法についてはこちらを参考にしてください。

Excel VBA 保存先フォルダをダイアログ指定で変数化

With ~ End With の使い方はこちらを参考にしてください。

With~End Withの使い方。VBAコードを簡潔に記述する

 

コード④

Sub 書誌名挿入()

step_cont:
Application.ScreenUpdating = False
Dim RP As Integer
Dim FileD As FileDialog

Set FileD = Application.FileDialog(msoFileDialogOpen)
    With FileD
        .ButtonName = "開く"
            With .Filters
                .Clear
                .Add "Excelブック", "*.xls; *.xlsx; *.xlsm", 1
                .Add "テキストファイル", "*.csv", 2
            End With
         .InitialFileName = ThisWorkbook.Path & "\書誌データベース\"
         .InitialView = msoFileDialogViewLargeIcons
            If .Show = True Then
                .Execute
    
            Else
                MsgBox "終了します。"
                Exit Sub
            End If
    End With

Call 書誌チェック

        With Range("F:J")
            .EntireColumn.AutoFit
        End With

RP = MsgBox("続けてデータベースを開きますか?" & vbCrLf &_ 
      "続けるには「はい」を" & vbCrLf & "終わるには「いいえ」を", _
  vbYesNo + vbQuestion, "確認")
    If RP = vbYes Then
        GoTo step_cont
    Else
        Application.ScreenUpdating = True
        Exit Sub
    End If

Application.ScreenUpdating = True
End Sub

 

書誌チェック プロシージャー

 

書誌名挿入 プロシージャーでファイルを開いた後は、別のプロシージャー「書誌チェック」を呼び出して書誌名検索に移ります。

雑誌やISBN書籍コードの桁数がおかしい場合は、検索自体を終了するかその検索だけをジャンプするかを選択します。

そのファイルでの検索が終了したら、次に別のファイルを開くかどうか聞いてきますので、

「はい」か「いいえ」で応答します。

 

 

MEMO

Len関数についてはこちらを参考にしてください。

Len関数・LenB関数で文字列の文字数を知る方法。使用例で解説します

Trim 関数についてはこちらを参考にしてください。

Trim関数・RTrim関数・LTrim関数 余分なスペースを取り除く関数の利用法

Right関数、Left関数についてはこちらを参考にしてください。

Mid関数・Right関数・Left関数は文字列操作の基本。使用例で解説します

Val関数についてはこちらを参考にしてください。

Val関数の使い方はデータ型不一致の解決策。値を文字列型から数値型へ

Match関数についてはこちらを参考にしてください。

エクセルVBAで使うMatch関数 活用度アップでテッパン関数に!

 

コード⑤

Private Sub 書誌チェック()

Application.ScreenUpdating = False
Dim ASrow As Long
Dim ASname As String
Dim SRV As Variant
Dim SC As Variant, SCt As Variant, Sr As Long, SCa As Long, SCS As String
Dim SCG As String, SN As Variant, SNS As Long
Dim s As Long
Dim MsgR As Integer

Dim BK As Workbook
Set BK = ActiveWorkbook
Dim BS As Worksheet
Set BS = BK.Worksheets("Sheet1")

Dim TB As Workbook
Set TB = Workbooks("書誌在庫表.xlsm")
Dim SS As Worksheet
Set SS = TB.Worksheets("作業シート")

TB.Activate
SS.Select
frow = Cells(Rows.Count, 6).End(xlUp).Row

For s = 2 To frow

SC = 0
TB.Activate
SS.Select
SRV = Range("F" & s).Value
If SRV = "" Then GoTo step_a
    SCS = CStr(SRV)
    
        If Len(Trim(SCS)) = 6 Then
                SC = CLng(Left(Trim(SCS), 4))
                SCG = CLng(Right(Trim(SCS), 2)) & "月"
                                
        ElseIf Len(Trim(SCS)) = 7 Then
        
                SC = CLng(Left(Trim(SCS), 5))
                SCG = CLng(Right(Trim(SCS), 2)) & "月"
                                
        ElseIf Len(Trim(SCS)) = 13 Then
                SCt = Right(Trim(SCS), 10)
                SC = Val(SCt)
                SCG = ""
                           
        Else
                   
                MsgR = MsgBox("コードの桁数が違います。" & vbCrLf & _
        "全体処理を中止しますか?(はい)" & vbCrLf & _
                              "この処理をJumpますか?(いいえ)", vbYesNo + vbExclamation)
                If MsgR = vbYes Then
                    Exit Sub
                Else

                End If
        End If
            
        BK.Activate
        BS.Select
        Sr = 0

            On Error Resume Next
            Sr = WorksheetFunction.Match(SC, Range("D:D"), 0)

            If Err.Number = 1004 Then

                Err.Clear

            Else
                SN = Range("I" & Sr)
                TB.Activate
                SS.Select
                If SN <> "" Then
                    Range("G" & s) = SN & " " & SCG
              
                End If
            End If
step_a:

Next s

With Range("G:G")
    .EntireColumn.AutoFit
End With
BK.Close False
Application.ScreenUpdating = True
End Sub

 

書誌データの重複削除、書名を取り出すVBAのまとめ

 

 

まとめるとこのようになります。

sagyosheet001234a

 

今回のこの記事部分が「書誌棚卸表.xlsm」のプログラムの核心部分となっています。

 

データを検索する部分は「Match」を使っています。

検索対象の書誌コードについては、いろいろなエラーとなるケースが考えれます。主だったエラーのケースを想定してVBAプログラムに反映させたつもりです。

想定に漏れたエラーが出たときはプログラムが停止してしまいますが、その都度コード修正でご対応お願いします。

 

次回記事は作業シートで書きだした「雑誌と書籍の在庫表」を新しいシートに清書するVBAコードについてです。

 

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

エクセルVBAで書誌の棚卸表を作成。調査個所別にシート表記する方法

 

エクセルVBAを独習するのに参考書は欠かせません。 参考書選びは自分に合った「相棒」にできるものを選んでいきたいです。
エクセルVBAの独習でおすすめ参考書を7冊選ぶ。良書との出会いは大切です

 

エクセルVBAの独習には動画学習という方法もあります。 目と耳両方を使って学習することでさらに勉強効率を上げることもできると思います。
エクセルVBA初級者がUdemyで動画学習する講座おすすめ5選と無料講座の上手な使い方。

 

エクセルVBAを使いだして、始めのうちに知っておきたい内容を纏めています。

「VBA最速理解」の記事一覧を開く

 

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

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