雑誌コードとISBNコードを使い易く加工するVBA

雑誌と書籍の在庫表作成のために、今回はバーコードリーダーで読み込んだISBNコードを使えるコードに加工します。
エクセルVBAを利用しますが、同時にコードの間違いチェックも行えるようにしていきます。

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

今回は「書誌棚卸表.xlsm」の「データコピー」と「作業シート」シートの作成のためのVBAコードを組み立てていきます。

雑誌と書籍の在庫リスト（棚卸表）作成の記事編成

雑誌と書籍の在庫リストの使い方とダウンロード
- 【棚卸し】無料入手！在庫管理の「雑誌と書籍の在庫リスト」DLと取説
- 雑誌と書籍の在庫リスト改訂版「スタック領域の不足」対策

書誌データベースのダウンロード
- 改訂版雑誌と書籍の在庫リスト書籍名データベース2020
- 雑誌名データベース2020 改訂版雑誌と書籍の在庫リスト

雑誌と書籍の在庫リストの作成手順

コンテンツ

雑誌コードとISBNコードの分解加工VBA

今回設置するシートの役割

VBAはこのような感じで組み立てていきたいと思います。

「データコピー」シートは使用するデータを置くシートとしています。

使用するデータは、

「コード入力表」のバーコードリーダーで読み込んだデータ
他から持ってきたコピーペーストしたデータ

のどちらでも使用できるようにしています。

使用データ選択方法は、ユーザーフォームに”トグルボタン”を設置します。

「作業シート」は使用するデータを加工するシートとしています。

データを加工する作業としては、

「作業シート」へ元となるデータを移動すると同時に、コードのエラーの明らかなものをチェックします。
元となるコードを使えるような形式に変換します。
同じものの冊数を数えます。
データベースと連携してコードから書名を探して表示します。

エラーの表示はセルを着色して表示します。

「データコピー」シートでのVBAコード

Module1にコードを記述して行く前に、宣言セクション（一番上段）にパブリック変数の宣言を行います。

2020年11月6日宣言方法で変数の適用範囲を変えるエクセルVBA

VBA

Public CP As Integer
Public Srow As Long
Public Krow As Long
Public ShopName As String
Public SpaceName As String

前回の記事で説明しましたが、「コード入力表」のバーコード読み取り操作が完了して、そのデータをこの「データコピー」シートに移す作業を行う場合、

「データ入力終了後の操作（シートから移動した時に起動）」で説明したVBAコードを起動します。

そこで説明している「バーコード」という名前のプロシージャーをModule1に先に記述しておきます。

変数「CP」はトグルボタン（バーコードモードボタン）が押された時に「１」を代入するように設定しています。

ボタンが押されていない時はこのプロシージャーは何もせず終了します。（読み取りデータを「データコピー」シートへは移しません。）

VBA

Sub バーコード()
        If CP = 1 Then
            Worksheets("コード入力表").Range("A:B").Copy _
                Destination:=Worksheets("データコピー").Range("A1")
            Application.CutCopyMode = False
        Else
            Exit Sub
        End If
End Sub

作業シートのVBAコード

「在庫情報コピー」という名前のプロシージャーを作ります。

このプロシージャーで行うことは、

「データコピー」シートのＡ列とＢ列のデータを「作業シート」にコピーペーストします。
「作業シート」のＣ列で同じ書誌の冊数を数えます。
取り込んだバーコードデータがエラーコードかどうかをチェックします。

エラーのチェックは、

18桁で且つ先頭3文字が「491」
13桁で且つ先頭3文字が「978」
13桁で且つ先頭３文字が「192」

以外のコードについてはその入力セルがクリーム色（エラー色）となります。

メッセージボックスで「色付きセルのデータを再チェックしてください！」を表示します。

VBA

Sub 在庫情報コピー()
        Worksheets("作業シート").Select
        Worksheets("データコピー").Range("A:A").Copy _
            Destination:=Worksheets("作業シート").Range("A1")
        Worksheets("データコピー").Range("B:B").Copy _
            Destination:=Worksheets("作業シート").Range("B1")
        Application.CutCopyMode = False
        Range("C1") = "冊数"
        Srow = Cells(Rows.Count, 1).End(xlUp).Row
        Range(Cells(2, 1), Cells(Srow, 2)) _
                                .Interior.ColorIndex = 19
        For i = 2 To Srow
            If Len(Range("A" & i)) = 18 Then
                If Left(Range("A" & i), 3) = 491 Then
                    Range("A" & i).Interior.ColorIndex = 0
                End If
            ElseIf Len(Range("A" & i)) = 13 Then
                If Left(Range("A" & i), 3) = 978 Then
                    Range("A" & i).Interior.ColorIndex = 0
                End If
            Else
            End If
            If Range("B" & i) = "" Then
                If Len(Range("A" & i)) = 18 Then
                    Range("B" & i).Interior.ColorIndex = 0
                ElseIf Range("A" & i) = "" Then
                    Range("B" & i).Interior.ColorIndex = 0
                End If
            ElseIf Len(Range("B" & i)) = 13 Then
                If Left(Range("B" & i), 3) = 192 Then
                    Range("B" & i).Interior.ColorIndex = 0
                End If
            Else
            End If
        Next i
            For Each CELS In Range(Cells(2, 1), _
                                        Cells(Srow, 2))
                If CELS.Interior.ColorIndex <> xlNone Then
                    n = 1
                End If
            Next CELS
            If n > 0 Then
                MsgBox "色付きセルのデータを再チェックしてください！"
            End If
End Sub

参考記事

2020年11月1日シートのコピーを最速に理解！VBAコードで異なる結果

2020年11月4日 If条件文のVBAコードの組み方。条件の絞り方を最速理解

2020年12月5日データ入力済セルの最終行番号を取得する

2021年6月23日 Len関数・LenB関数で文字列の文字数を調べる

2021年7月3日 Mid関数・Right関数・Left関数は文字列中の文字を切り出す

2020年11月8日 VBA 回数不定のループ処理はDo LoopとFor Each

2022年7月16日「塗りつぶし」背景色をVBAで記述する

「書誌コードチェック」という名前のプロシージャーを作ります。

このプロシージャーで行うことは、

元のコードから雑誌コードを抜き出します。
元のコードから雑誌の価格情報を抜き出します。
書籍の価格コードから価格情報を抜き出します。
同じ書誌の数量をカウントします。

コードのエラーが表示されているときは、このプロシージャーを実行する前に訂正が必要です。

VBA

Sub 書誌コードチェック()
    Dim TCA As Variant, TCB As Variant
    Dim ZC As Long, ZCa As Long, ZK As Long, ZS As Long
    Dim ZKa As Variant, ZKb As Long
    Dim t As Long
        Worksheets("作業シート").Select
        Krow = Cells(Rows.Count, 1).End(xlUp).Row
        SC = MsgBox("コードチェックはＯＫですか？", vbYesNo + _
                        vbQuestion, "確認")
        If SC = vbYes Then
            For Each CELS In Range(Cells(2, 1), Cells(Krow, 2))
                CELS.Interior.ColorIndex = 0
            Next CELS
        Else
            Exit Sub
        End If
        For t = 2 To Krow
            TCA = Range("A" & t)
            TCB = Range("B" & t)
            
            If Left(TCA, 4) = 4910 Then
                ZC = Mid(TCA, 5, 7)
                ZK = Right(TCA, 5)
                ZS = Len(TCA)
                Range("A" & t).Value = ZC
                If ZS = 18 Then
                    Range("B" & t).Value = ZK
                Else
                    Range("B" & t).Value = ""
                End If
            End If
            If Left(TCB, 3) = 192 Then
                ZKa = Left(TCB, 12)
                ZKb = Mid(ZKa, 8, 12)
                Range("B" & t).Value = ZKb
            End If
        Next t
        t = 2
        Do While t <= Krow
            Range("C" & t) = WorksheetFunction _
                        .CountIf(Range("A:A"), Range("A" & t))
            t = t + 1
        Loop
End Sub

参考記事