[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『チェックデジットNoを出すマクロ』（キリキ）
[スマートにならない・・・]
いつもお世話になっております。 今回ご相談したいのは、チェックデジット№（JANコードの最後の数字）を出すマクロを 作成中なのですが。。。 何て言うか、ど～も スマートになりません（TT）
諸先輩方に、ツッコミを入れていただくために久々の登校をしてみました(^^;)
Sub CD算出()
Dim a As Byte, b As Byte, c As Byte, d As Byte, e As Byte, _
f As Byte, g As Byte, h As Byte, i As Byte, j As Byte, _
k As Byte, l As Byte
Dim mozisuu As Integer
Dim x As Byte, y As Byte, z As Byte, cd As Byte
x = 1
y = 3
On Error GoTo trbl
IsError (Range("a1") * 1)
mozisuu = Len(Range("a1"))
If mozisuu = 12 Then
a = Mid(Range("a1"), 1, 1)
b = Mid(Range("a1"), 2, 1)
c = Mid(Range("a1"), 3, 1)
d = Mid(Range("a1"), 4, 1)
e = Mid(Range("a1"), 5, 1)
f = Mid(Range("a1"), 6, 1)
g = Mid(Range("a1"), 7, 1)
h = Mid(Range("a1"), 8, 1)
i = Mid(Range("a1"), 9, 1)
j = Mid(Range("a1"), 10, 1)
k = Mid(Range("a1"), 11, 1)
l = Mid(Range("a1"), 12, 1)
z = ((a * x) + (b * y) + (c * x) + (d * y) + (e * x) + (f * y) _
+ (g * x) + (h * y) + (i * x) + (j * y) + (k * x) + (l * y)) Mod 10
cd = 10 - z
cd = Right(cd, 1)
MsgBox "C/D№は" & cd & "でんな"
End If
Exit Sub
If mozisuu < 12 Then
MsgBox "桁数が不足でっせ"
End If
If mozisuu > 12 Then
MsgBox "桁数が多すぎまっせ"
End If
Exit Sub
trbl:
MsgBox "数字を１２桁入力してくんなはれ"
End Sub
どうぞよろしくお願いいたしますm(._.)m
キリキさんのコードを精一杯活かして汗
あんまりスマートじゃないけど、みぃならこんな感じかな？？
でも、答えはあってるかな？？汗
Option Explicit
Sub CD算出()
Dim C As Range
Dim i As Long, z As Long
Set C = Range("a1")
If IsNumeric(C) And Len(C) = 12 Then
For i = 1 To Len(C)
Select Case i Mod 2
Case 1
z = z + Mid(C, i, 1) * 1
Case 0
z = z + Mid(C, i, 1) * 3
End Select
Next
MsgBox "C/D№は" & Right((10 - (z Mod 10)), 1) & "でんな"
ElseIf IsNumeric(C) And Len(C) < 12 Then
MsgBox "桁数が不足でっせ"
ElseIf IsNumeric(C) And Len(C) > 12 Then
MsgBox "桁数が多すぎまっせ"
Else
MsgBox "数字を１２桁入力してくんなはれ"
End If
End Sub
（SoulMan）
To SoulManさん いつもありがとうございます。 エクセレント～(^0^)
IsNumericとLenを一緒に処理をすること ｚの箱の中に、数字をドンドン足していくこと 目の前に出されると あ～ なるほど～ と思うのですが、作っている最中は そこまで思いつかないんですよ(;_;)
For～Nextのコツが少しわかった気がします(^^) またまた勉強になりましたm(._.)m （キリキ）
ちょっと訂正汗
>IsNumericとLenを一緒に処理をすること
最初に判断した方がいいような気がします。汗
少数点があると駄目なので、そこをちょっと改良
.Value は省略しない方がいいです。って、、みぃのことだべ汗
というわけで、、こんな感じになりました。
（SoulMan）
Option Explicit
Sub CD算出()
Dim C As Range
Dim i As Long, z As Long
Set C = Range("a1")
If Not IsEmpty(C.Value) And IsNumeric(C.Value) Then
If Int(C.Value) = C.Value Then
Select Case Len(C.Value)
Case 12
For i = 1 To Len(C.Value)
Select Case i Mod 2
Case 1
z = z + Mid(C.Value, i, 1) * 1
Case 0
z = z + Mid(C.Value, i, 1) * 3
End Select
Next
MsgBox "C/D№は" & Right((10 - (z Mod 10)), 1) & "でんな"
Case Is < 12
MsgBox "桁数が不足でっせ"
Case Is > 12
MsgBox "桁数が多すぎまっせ"
End Select
Else
MsgBox "整数で入力してください。"
End If
Else
MsgBox "数字を１２桁の整数で入力してくんなはれ"
End If
Set C = Nothing
End Sub
失礼！Setしたら開放！！ごめんちゃいm(__)m
遅レスすいません。。。 改めて感服いたしました(^^)
で、一つ質問があります SoulManさんは ＞少数点があると駄目なので、 とのことですが、自分としてはそこまで考えつかなかったです(^^;) 逆に説明不足もあるのですが、JANコードは頭に０（ゼロ）が続く場合があります。 よって、セルの書式を”文字列”に設定いたしております。 そのため全てが ＞MsgBox "整数で入力してください。" に引っかかってしまいます。
頭に０が来てもいいように設定し、且つ小数点等にも対応するには どういう分岐？をしたらよろしいでしょうか？ （キリキ）
>JANコードは
というものがどんなものかよくわからないけど、
最初に空白じゃなくて数値だったら・・・
としているので、次に
小数点がなかったら・・・
としてはどうでしょうか？
v(=∩_∩=)v
（SoulMan）
Option Explicit
Sub CD算出()
Dim C As Range
Dim i As Long, z As Long
Set C = Range("a1")
'空白じゃなくて数値だったら
If Not IsEmpty(C.Value) And IsNumeric(C.Value) Then
'小数点がなかったら
If InStr(1, C.Value, ".") = 0 Then
Select Case Len(C.Value)
Case 12
For i = 1 To Len(C.Value)
Select Case i Mod 2
Case 1
z = z + Mid(C.Value, i, 1) * 1
Case 0
z = z + Mid(C.Value, i, 1) * 3
End Select
Next
MsgBox "C/D№は" & Right((10 - (z Mod 10)), 1) & "でんな"
Case Is < 12
MsgBox "桁数が不足でっせ"
Case Is > 12
MsgBox "桁数が多すぎまっせ"
End Select
Else
MsgBox "整数で入力してください。"
End If
Else
MsgBox "数字を１２桁の整数で入力してくんなはれ"
End If
Set C = Nothing
End Sub
SoulManさん、パーフェクトです！！ 凄過ぎます！！
>>JANコードは >というものがどんなものかよくわからないけど、 バーコードのことです。 商品に付いている、親父の禿頭みたいなやつです(^^;) 日本の商品のJANは、４or２から始まるものが多いですが 輸入商品などは０から始まる物もあるようです。
とにかくありがとうございました(^^) （キリキ）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.