Excelで数値を桁ごとに置き換える方法について

質問

Excelのある列に、例えば顧客番号として10桁の数値（文字列：NULLやALL０を含む）が大量に並んでいるとします。
これらに対しNULLやオールゼロではない場合に、それぞれの桁を下記のような規則に従って置きかえる方法を考えているのですが、何か良い方法はないでしょうか。

****規則*********

１～２桁目
変更前が１の場合５に、２の場合４に、３の場合１に…（以下９、０まで条件あり）置き換え

３～４桁目
変更前が１の場合６に、２の場合３に、３の場合２に…（以下９、０まで条件あり）

５～６桁目
変更前が１の場合７に、２の場合３に、３の場合６に…（以下９、０まで条件あり）

７～８桁目
変更前が１の場合４に、２の場合１に、３の場合８に…（以下９、０まで条件あり）

９～１０桁目
変更前が１の場合５に、２の場合１に、３の場合８に…（以下９、０まで条件あり）

******************

例えば、

1321231221

という数値（文字列）がある場合、

5136364115

という結果が別のセルにできるような形です。
関数であれば、まずNULLやALL0でない場合に、とIF文で規定し、それぞれの桁を10個のセルに分解して、さらにIF文で10個分岐を組んだ物をそれぞれのセルに適用させ、最終的に再度結合させれば何とかできなくはなさそうですが、数万セルに及ぶのでVBAで次のセル次のセル…とやった方が効率的だと考えます。

ただ、そんなVBAができれば良いのですがなかなか思いつきません…。

どなたかご教示いただけませんでしょうか。

回答No.2

ki-aaa · ベストアンサー

試してみて

Sub テストデータ()
Dim i As Long
Dim 行 As Long
Sheets("Sheet2").Select
For i = 1 To 10000
Cells(i, 1) = Int(10000000000# * Rnd)
Next i
End Sub

Sub 変換()
Dim i As Long, j As Long, k As Long
Dim tb_1(0 To 9, 1 To 10) As String
Dim aa_1
Dim sss As String
Dim ttt As String

'変換テーブル　"Sheet1"の"A10:J19" に作る
'AB..1～2桁 CD..3～4桁 ・・・・・
'10行から19行・・・下一桁数字(0～9)を何に変換するか
'例　"B15"に3...二桁目の5を3に変える
Sheets("Sheet1").Select
For i = 0 To 9
For j = 1 To 10
tb_1(i, j) = Cells(i + 10, j)
Next j
Next i

'変換
Sheets("Sheet2").Select
i = Range("A" & Rows.Count).End(xlUp).Row
aa_1 = Range("A1").Resize(i, 1).Value

For i = 1 To UBound(aa_1)
If IsNull(aa_1(i, 1)) Then
ElseIf Len(aa_1(i, 1)) > 10 Then
aa_1(i, 1) = ""
ElseIf aa_1(i, 1) = 0 Then
aa_1(i, 1) = ""
Else
sss = Format(aa_1(i, 1), "0000000000")
ttt = ""
For j = 1 To 10
k = Mid$(sss, j, 1)
ttt = ttt & tb_1(k, j)
Next j
aa_1(i, 1) = ttt
End If
Next i

'結果
Sheets("Sheet3").Select
Range("A1").Resize(UBound(aa_1), 1).NumberFormatLocal = "@"
Range("A1").Resize(UBound(aa_1), 1).ClearContents
Range("A1").Resize(UBound(aa_1), 1).Value = aa_1

End Sub

お礼

素晴らしいご回答ありがとうございます。
試してみましたところ、残念ながらこちらの希望する通りの結果が出ませんでした…。

どのように試したかを下記いたします。方法で間違っている部分もあるかも
しれませんので、その場合はご指摘いただければ幸いです。

------------

（１）変換テーブル作成
　"Sheet1"の"A10～J19"に変更後の数値を入力
（A10、B10には1桁目、2桁目が1だった場合の変更後数値である"5"を入力、
　A11、B11には1桁目、2桁目が2だった場合の変更後数値である"4"を入力、
　以下同様にJ19までそれぞれの変更後数値を入力）

（２）テストデータ作成
　ご教示いただいたVBAの「テストデータ」を実行
　"Sheet2"の"A1～A10000"にランダムな10桁の数値
　（1桁目がゼロの場合、ゼロは表示されず9桁の数値となる）が自動表示された

（３）数値変換
　ご教示いただいたVBAの「変換」を実行
　"Sheet3"の"A1～A10000"に変更後と思しき10桁の数値
　（文字列：1桁目がゼロの場合でもゼロは表示され10桁となる）が自動表示された

-----------

問題１
（３）の結果が、（１）で作成したテーブル通りとならない
　想定上結果：　変更前1111111111　⇒変更後5566774455（Sheet1のA10～J10を並べた数値）
　上記結果：　変更前1111111111　⇒変更後4433331111

問題２
（２）をせず、直接Sheet2のA1に'1111111111と入力し（３）を実行したところ
　MSG「実行時エラー'13'　型が一致しません」が表示
　デバッグ表示箇所⇒　For i = 1 To UBound(aa_1)

もしお時間がございましたら、ご確認・ご教示いただければ幸いです。
お手数をおかけいたしますが、なにとぞ宜しくお願いいたします。

回答No.8

ki-aaa

補足、ありがとうございます。

>元がNULL⇒結果もNULL
>元がゼロのみ⇒結果もゼロのみ

これは、配列に対して、IsNullが効かないんですね。
私も勉強になりました。
次のように変更してください。

>If IsNull(aa_1(i, 1)) Then
↓
If aa_1(i, 1) = "" Then

お礼

ご確認ありがとうございます。

変更テストしました。問題なくNULL⇒NULL、０値⇒オールゼロとなりました。
（感動しました。）
あとはうまく数値としてデータをセットするだけです。

何度もご丁寧にありがとうございました！

-----------------

このお礼入力欄をお借りして、ご回答を下さった皆様に改めてお礼いたします。
本当にありがとうございました。

また、ベストアンサーにつきましては、
もう一人の方の回答も非常に良い内容ではあったのですが、
ki-aaa様の回答の方が
・より要件を満たす内容となった（NULL,オールゼロ）点と
・変換テーブルをユーザーにも見える形とした方が「今回は」より有用であるという点
　（変換規則のメンテナンスがしやすい、チェックがしやすい等）
から、より私の希望に合ったということで、ベストアンサーとさせていただきます。

私の中では二つともベストアンサーにしたいところなのですが、
システム上一つしか選択できませんので、なにとぞご了承くださいませ。

繰り返しになりますが、皆様本当にありがとうございました。勉強になりました。

回答No.7

Wendy02

#6の回答者です。
>実行時エラー6
>オーバーフローしました。
失礼しました。エラー確認しました。
普通は、Range オブジェクトからとれば、数値を取り出せるのですが、もともと、文字列の条件なので、そのまま10桁と認識するのは想定外でした。

以下は、そのまま考えもせずに関数を換えるのは格好が良くないのですが、こういう方法で対処します。

If CLng(sNum) = 0 Then Exit Function
　　　　　↓
If CDbl(sNum) = 0 Then Exit Function
もし、それでもトラブルあるようなら、
If CDbl(Fix(sNum)) = 0 Then Exit Function
としてください。

お礼

お忙しい中、ご確認いただきありがとうございます。

If CDbl(sNum) = 0 Then Exit Function

でも

If CDbl(Fix(sNum)) = 0 Then Exit Function

でもいずれもエラーは発生せず問題なく動きました。

ご回答ありがとうございました！！

回答No.6

Wendy02

質問読んでみましたが、これは、初歩的な暗号システムの一種ですね。
こちらは、VBカテゴリですから、VBA以外の回答は考えていません。
他の方のマクロを良く見ていませんが、あまり深く考えておりません。なお、変更ある場合は、コードをよく読めば可能だと思います。現在は、ActiveSheetのA列を対象として、結果は、同じ行のB列に出力します。

オールゼロに関しては、ゼロの文字が入っている以上は変換させてしまいますから、不要でしたら、IsNumericの後の　'If Clng(sNum) = 0 コメントブロックを外してください。

それと、初歩的なことですが、ワークシートのセルに、VBAで言うNull値は存在しません。

暗号システムということで、VBEditor 上の変換テーブルを書くことにします。

なお、1～2桁目・・・という文言が、文字列として数えているようですから、左から取るようにしています。数値なら、右から取るはずです。

'//モジュールトップに置く(標準モジュール用）
'変換テーブル 1,2,3,4,5,6,7,8,9,0
Private Const N1 = "5,4,1,0,8,2,3,6,7,9"　'1～2桁目
Private Const N2 = "6,3,2,1,5,4,0,7,9,8"　'3～4桁目
Private Const N3 = "7,3,6,4,6,2,1,5,9,8"　'5～6桁目
Private Const N4 = "4,1,3,9,2,6,8,0,7,5"　'7～8桁目
Private Const N5 = "5,1,8,2,3,0,4,6,9,7"　'9～10桁目
Private Ns1 As Variant
Private Ns2 As Variant
Private Ns3 As Variant
Private Ns4 As Variant
Private Ns5 As Variant

Sub TestConvert()
　Dim rng As Range
　Dim c As Range
　Dim buf As Variant
　Ns1 = Split(N1, ",")
　Ns2 = Split(N2, ",")
　Ns3 = Split(N3, ",")
　Ns4 = Split(N4, ",")
　Ns5 = Split(N5, ",")
　With ActiveSheet
　Set rng = .Range("A1", .Cells(Rows.Count, 1).End(xlUp))
　Application.ScreenUpdating = False
　For Each c In rng
　　　buf = ConvertNum(c.Text)
　　　c.Offset(, 1).Value = "'" & buf
　Next
　Application.ScreenUpdating = True
　End With
　Set rng = Nothing
End Sub
Function ConvertNum(sNum As Variant)
　Const K As Integer = 10
　Dim num As String
　Dim i As Long, j As Long
　Dim ar As Variant
　Dim buf As String
　'数値は左側から取る、不足分は0を加える
　If IsNumeric(sNum) = False Then Exit Function '数値でない場合
　'If Clng(sNum) = 0 Then Exit Function 'すべて0の場合
　sNum = CStr(sNum)
　If Len(sNum) < K Then
　　 sNum = sNum & String(K - Len(sNum), "0")
　Else
　　 sNum = Left(sNum, K)
　End If
　For i = 1 To 10 Step 2
　　num = Mid(sNum, i, 2)
　　Select Case i
　　　Case 1: ar = Ns1
　　　Case 3: ar = Ns2
　　　Case 5: ar = Ns3
　　　Case 7: ar = Ns4
　　　Case 9: ar = Ns5
　　End Select
　　For j = 1 To Len(num)
　　　buf = buf & ar((Mid(num, j, 1) + 9) Mod 10)
　　Next
　Next
　　ConvertNum = buf
End Function

お礼

こちらもまた素敵なご回答をありがとうございます。
なるほど、モジュールに直接変換テーブルを書き込む形ですね。
実行の観点からするとスマートな感じです。

おっしゃる通り、ご教示いただいたままですと
オールゼロの場合でもゼロに対比する数値に置き換えてしまいました。

ですのでこちらもご教示いただいた通り、

'If Clng(sNum) = 0 Then Exit Function 'すべて0の場合

の部分を

If CLng(sNum) = 0 Then Exit Function 'すべて0の場合

としました。

ところがここで一点問題が。

実行時エラー6
オーバーフローしました。

というメッセージが表示されてしまいました。

ここの原因および解決方法について、ご教示いただければ幸いです。

回答No.5

layy

１０ケタを１０個の文字に分解
1 → +4 → 5
3 → +8 → 1
2 → +1 → 3
1 → +5 → 6
2 → +1 → 3
3 → +3 → 6
1 → +3 → 4
2 → +9 → 1
2 → +9 → 1
1 → +4 → 5
→
１０個の文字を連結し、「5136364115」

繰上は無視し単に加算してやるというのなら、
これだと変換前１ケタ目が1や2でも判定は必要なく結果適当な数列になります。
1321231222→5136364116
1321231223→5136364117
全然意味のない数列にしたいだけ、というのならこういうこともあります。

参考で。

お礼

なるほど、数列の変更方法にはこういうこともあるのですね。
参考にさせていただきます。

ご回答ありがとうございました。

回答No.4

ki-aaa

補足、ありがとうございます。

>（１）変換テーブル作成
>　"Sheet1"の"A10～J19"に変更後の数値を入力
>（A10、B10には1桁目、2桁目が1だった場合の変更後数値である"5"を入力、
>　A11、B11には1桁目、2桁目が2だった場合の変更後数値である"4"を入力、
>　以下同様にJ19までそれぞれの変更後数値を入力）

行が、一つづつずれています。
（A10、B10には1桁目、2桁目が"0"だった場合の変更後数値である"?"を入力、
　A11、B11には1桁目、2桁目が"1"だった場合の変更後数値である"5"を入力、
　A12、B12には1桁目、2桁目が"2"だった場合の変更後数値である"4"を入力、

問題２
（２）をせず、直接Sheet2のA1に'1111111111と入力し（３）を実行したところ
　MSG「実行時エラー'13'　型が一致しません」が表示
　デバッグ表示箇所⇒　For i = 1 To UBound(aa_1)

これは、データが一つしかないときiが1になり、
aa_1 = Range("A1").Resize(i, 1).Value　を実行したら
Range("A1").Resize(i, 1).Valueが一つのセルを指定しているので
aa_1が配列になっていません。
それで、UBound(aa_1)がエラーになります。
対策は、If i = 1 Then i = 2の一行を追加してください。

'変換
Sheets("Sheet2").Select
i = Range("A" & Rows.Count).End(xlUp).Row
If i = 1 Then i = 2
aa_1 = Range("A1").Resize(i, 1).Value

お礼

わかりやすい解説、ありがとうございます。
問題点もクリアできましたので、これでほとんどよさそうです。

ただ、一点だけ
NULL（セルに何も入力されていない状態）も
オールゼロが入力されている場合も、いずれも結果が
NULL（セルに何も入力されていない状態）となります。

元がNULL⇒結果もNULL
元がゼロのみ⇒結果もゼロのみ

となれば最高なのですが、そのような方法はございますでしょうか。

ElseIf aa_1(i, 1) = 0 Then
aa_1(i, 1) = ""

を

ElseIf aa_1(i, 1) = 0 Then
aa_1(i, 1) = "0000000000"

とすると、今度はいずれもオールゼロとなってしまいますし…
Excelだとそういう結果になるものなのでしょうか。

この方法でもかなり負荷が短縮できそうなので十分ではありますが、
もしお時間があるようでしたらご教示いただければ幸いです。

回答No.3

layy

ＶＢＡでいいと思います。

変換が単純ですし、わざわざ配列にしなくても
ＩＦ文でもよさそうですが。

１ケタ目の変換でＡ１の１０ケタ（１０バイト）参照、
２ケタ目の変換でＡ１の１０ケタ（１０バイト）参照、
３ケタ目の変換でＡ１の１０ケタ（１０バイト）参照、
・・・・
これでは遅いかもしれません。

数万のセルということなら、
いかにセルへの参照、算出回数を少なくするかでしょうね。
同じセルを何度も参照して求めるよりはできるだけ少ない回数になるように組む。

お礼

ご回答ありがとうございます。
VBAの方がやはりよさそうですよね。
ただ、
＞同じセルを何度も参照して求めるよりはできるだけ少ない回数になるように組む。
ここがネックです…問題なく組めれば良いのですが、どのようにすれば良いか
わからず、困っているところです…。

回答No.1

SaKaKashi

関数を作って貼り付けるだけでしょ。VBAでするほどのこともなく。

お礼

ご回答ありがとうございます。
関数でできる内容かとは思うのですが、
膨大な量ですので手作業をなるべく減らしたく
VBAの方が（ちゃんと作りさえすれば）結果として早く
また貼り付け漏れとかもないかなと思う次第です。