Excel ユーザ定義関数による JAN コード生成

JAN コード

集合包装用商品コード(ITFコード)（14桁）を使った場合。参考サイト

関数種類

• JAN()
  JANコード(14桁)の数値を返す。
  引数：13桁の数値(Double)，返り値：14桁の数値(Double)
• SJAN()
  JANコード(14桁)の文字列を返す。
  引数：13桁の数値(Double)，返り値：14桁の文字列(String)
• JAN_CHKD()
  JANコード(14桁)のチェックデジット(末尾1桁)を返す。
  引数：13桁の数値(Double)，返り値：1桁の数値(Integer)

追加方法

1. エクセルを起動
2. 空白のブックを作成する
3. Alt + F11 を押下
4. メニュー「挿入(I)」→標準モジュール(M)
5. 下記のソースコードを貼り付け
6. マクロ有効ブック(.xlsm)で保存する

ソースコード

'先頭宣言
Option Explicit

'
'JANコード生成(文字列型)
'2018-04-23
'
'ITFコードに基づくJANコード(14桁)を生成する
'13桁の入力値から末尾にチェックデジット1桁を付加して14桁の文字列を返す
'
'1)入力値が13桁数値か判定する　→　それ以外はエラー終了
'2)入力値を桁分解して配列変数「桁分解(n)」へ格納
'  　一位→桁分解(2)
'　　十位→桁分解(3)
'  　百位→桁分解(4)
'  　…
'  一兆位→桁分解(14)
'3)偶数桁 桁分解(n) n=14,12,10,8,6,4,2 を合計して3倍する
'4)奇数桁 桁分解(m) m=13,11, 9,7,5,3   を合計する
'5)上記3)と4)を合計する
'6)上記5)の下1桁の数字を10から引く　→　桁分解(1)に格納する(チェックデジット)
'  ※下1桁がゼロで 10 - 0 = 0 のときは、桁分解(1)にゼロを格納する
'
Function SJAN(入力値 As Double) As String

    '変数定義
    Dim 文字列化 As String
    Dim 桁分解(14) As Integer
    Dim i As Integer
    Dim 偶数桁 As Integer
    Dim 奇数桁 As Integer
    
    '再計算の有効化
    Application.Volatile
    
    '入力値は13桁を超過しているか
    '超過した場合は #NUM! を返す
    If Len(CStr(入力値)) > 13 Then
        SJAN = CVErr(xlErrNum)
        Exit Function
    End If
    
    '入力値を13桁に揃える
    '文字列に変換する
    文字列化 = Right("0000000000000" & CStr(入力値), 13)
        
    '配列変数「桁分解(n)」に格納する
    '
    For i = 14 To 2 Step -1
        桁分解(i) = Val(Mid(文字列化, 15 - i, 1))
    Next i

    '偶数桁を合計して3倍する
    'Σ桁分解(n)  n=14,12,10,8,6,4,2
    For i = 2 To 14 Step 2
        偶数桁 = 偶数桁 + 桁分解(i)
    Next i
    '
    偶数桁 = 偶数桁 * 3

    '奇数桁を合計する
    'Σ桁分解(n)  n=13,11,9,7,5,3
    For i = 3 To 13 Step 2
        奇数桁 = 奇数桁 + 桁分解(i)
    Next i
    
    '桁分解(1)にチェックデジットを保存する
    '
    桁分解(1) = 10 - Val(Right(CStr(偶数桁 + 奇数桁), 1))
    If 桁分解(1) = 10 Then 桁分解(1) = 0
    
    'JANコードを返す
    '
    For i = 14 To 1 Step -1
        SJAN = SJAN & CStr(桁分解(i))
    Next i

End Function


'
'JANコード生成(数値型)
'2018-04-23
'
'ユーザ定義関数JANSへ入力値を渡し、返り値(文字列)を数値へ変換する
'
Function JAN(入力値 As Double) As Double

    JAN = Val(SJAN(入力値))

End Function


'
'JANコード　チェックデジット生成
'2018-04-23
'
'ユーザ定義関数JANSへ入力値を渡し、返り値(文字列)の下1桁を抽出して数値化する
'
Function JAN_CHKD(入力値 As Double) As Integer

    JAN_CHKD = Val(Right(JAN(入力値), 1))

End Function