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

Question

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

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

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

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

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

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

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

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

例えば、

1321231221

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

5136364115

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

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

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

ki-aaa · Accepted Answer

試してみて

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

ki-aaa · Answer

補足、ありがとうございます。
 
>元がNULL⇒結果もNULL
>元がゼロのみ⇒結果もゼロのみ

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

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

Wendy02 · Answer

#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
としてください。

Wendy02 · Answer

質問読んでみましたが、これは、初歩的な暗号システムの一種ですね。
こちらは、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

layy · Answer

１０ケタを１０個の文字に分解
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
全然意味のない数列にしたいだけ、というのならこういうこともあります。

参考で。

ki-aaa · Answer

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

>（１）変換テーブル作成
>　"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

layy · Answer

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

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

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

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

SaKaKashi · Answer

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

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

試してみて

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

#6の回答者です。

質問読んでみましたが、これは、初歩的な暗号システムの一種ですね。

１０ケタを１０個の文字に分解

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

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

関数を作って貼り付けるだけでしょ。

似たような質問が見つかりました

関連するカテゴリからQ&Aを探す

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング