2011年2月28日月曜日

JANコード算出 VBA

普段はほとんど使用しないけれども、使う場面が来たらやたら重宝するとおもいます。
セル埋め込みでも出来ますがコードの方がセル内容がシンプルになります。


Public Function JANCD(argCode As Variant) As Variant
Dim strCode As String
Dim intDigit As Integer
Dim intPos As Integer
Dim intCD As IntegerIf IsNull(argCode) Then Exit Function
If Not IsNumeric(argCode) Then Exit FunctionSelect Case Len(argCode)
Case 7, 8
strCode = Left(argCode, 7)
For intPos = 1 To 7 Step 2
intDigit = intDigit + CInt(Mid(strCode, intPos, 1))
Next
intDigit = intDigit * 3
For intPos = 2 To 6 Step 2
intDigit = intDigit + CInt(Mid(strCode, intPos, 1))
Next
Case 12, 13
strCode = Left(argCode, 12)
For intPos = 2 To 12 Step 2
intDigit = intDigit + CInt(Mid(strCode, intPos, 1))
Next
intDigit = intDigit * 3
For intPos = 1 To 11 Step 2
intDigit = intDigit + CInt(Mid(strCode, intPos, 1))
NextCase Else
Exit Function
End SelectintCD = intDigit Mod 10
If intCD <> 0 Then
intCD = 10 - intCD
End IfJANCD = strCode & Format(intCD)
End Function


標準モジュールで使用

0 件のコメント: