[[20190522114232]]　『10桁のランダムな数字をそれまでに発生していない』（ＭＳＣＬ）　ページの最後に飛ぶ

『10桁のランダムな数字をそれまでに発生していない数字で、』（ＭＳＣＬ）

ある列のセルに10桁の乱数を発生させていきたいのですが、セル範囲を選んでその範囲のセルに重複しない数字を埋めるというのではなく、最初は、何も埋まっていない状態から、都度重複しない数字を発生させていくには、どうしたらよいでしょうか…

完全にくれくれに近い質問で申し訳ありません。

例えば、今、『採番』のボタンを押すと、A1のセルだけに10桁のランダムな数字を発生させます。
次に、『採番』のボタンを押すと、A2のセルにランダムな10桁の数字を発生させますが、A1と重複しないようにしたい、
さらに次、『採番』を押すと、A3には、A1,A2のどちらとも重複しない10桁のランダムな数字を発生、
…『採番』を押すと、A4に、A1,A2,A3のいずれとも重複しない10桁のランダムな数字を発生させたい…
…A5に、A1,A2,A3,A4のいずれとも重複しない10桁のランダムな数字を発生させたい…
(列は、1列だけで構いません。)

ということをひたすら繰り返すということなのですが、可能でしょうか。
要するに『採番』できるVBAです。よろしくお願いします。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

https://www.moug.net/tech/exvba/0050060.html
などが参考になるかと思います。乱数そのものは
ワークシート関数のランドビツーインってのもあ
りますのでそちらを使えば簡単かもです。

（隠居じーさん） 2019/05/22(水) 12:15

採番ならば、最終値+1にすれば重複なんてしないし、簡単ですよ？固定で+1だと類推されるのがまずい、とかならば、最大何行を考えているのか次第ですが、+する値をランダムで決めるとか。

そして、どうしても乱数にしたいならば、重複しても良いから乱数を発生させてみて、それが過去の数値と重複していないか調べて、重複していたらやり直しループするようなロジックで十分ではないでしょうか。 10桁もあるなら、そうそう重複はしないでしょうし。
（???） 2019/05/22(水) 13:14

10桁の数字となると、Long型では桁数オーバーですので、Double か Decimal でないとダメですね。
ワークシート関数のRndBetween も10桁だとエラーになります。

乱数を生成した後でその数を検索して、
見つかれば（重複があれば）ループする、
というロジックになりますね。

 'フォームコントロールのボタンのマクロ
Sub 採番_Click()
    Dim tarCell As Range
    If Cells(1, 1) = "" Then
        Set tarCell = Cells(1, 1)
    Else
      Set tarCell = Cells(Rows.Count, 1).End(xlUp).Offset(1)
    End If

    Randomize

    Dim minNum As Double, maxNum As Double
    minNum = 1000000000#
    maxNum = 9999999999#

    Dim Num As Double
    Do
        Num = Int((maxNum - minNum + 1) * Rnd + minNum)
        If Range(Cells(1, 1), tarCell).Find(Num, LookAt:=xlWhole) Is Nothing Then
            tarCell.Value = Num
            Exit Do
        End If
    Loop
End Sub

（hatena） 2019/05/22(水) 13:25

あれ、RandBetween でもいけましたよ？（代入先が2行目からになるのは手抜きしたせい）

 Private Sub CommandButton1_Click()
    Dim iw As Double
    Dim iNum As Long

    Randomize
    iNum = 1

    While 0 < iNum
        iw = WorksheetFunction.RandBetween(1000000000#, 9999999999#)
        iNum = WorksheetFunction.CountIf(Range("A:A"), iw)
        DoEvents
    Wend
    Cells(Rows.Count, "A").End(xlUp).Offset(1, 0).Value = iw
 End Sub
（???） 2019/05/22(水) 13:38

 いや～様々な方法があるのですね～配列がオーバーフローするので
どうかな～とか悩んでいました。Int、が使えるか心配でしたが何とか？

 Sub OneInstance()
    Dim RdNum As Currency
    Dim D As Object
    Randomize
    Set D = CreateObject("Scripting.Dictionary")
    Do Until D.Count > 9
    '乱数=Int((最大値 - 最小値 +1 ) * Rnd + 最小値)
        RdNum = Int((9999999999# - 1000000000 + 1) * Rnd + 1000000000)
        If Not D.Exists(RdNum) Then
            D.Add RdNum, RdNum
        End If
    Loop
    MsgBox Join(D.keys, ",")
End Sub
（隠居じーさん） 2019/05/22(水) 14:07

???さん

あれ、RandBetween でもいけましたよ？

あら、普通にいけますね。
よく見たら、RndBetween となってるわ。タイプミスでした（汗）。
（hatena） 2019/05/22(水) 15:46

hatenaさん、???さん、隠居じーさん、
大変迅速にご回答頂きありがとうございました。
お手数をおかけしました。とても助かりました。

数値ということで、せっかくご回答頂きましたが、文字列にする必要が出てきて、
でも、数値は数値で、とても勉強になりました。

先頭にアルファベット、途中にハイフォンを付加して…
主に、hatenaさんのコードを利用させて頂き、最終的には、下のような形になりました。

序盤の部分もどなたかのを利用させて頂いてます…自分では、ほとんど理解できておらず…
VBA初心者なのでおかしなところがあるかも知れません…致命的なことがあればご指導ください。

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

_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/_/

Option Explicit

Private Const ALP As String = "A,B,C,D,E,F,G,H,J,K,L,M,N,P,Q,R,S,T,U,V,W,X,Y,Z"
Private Const bNUM As String = "0,1,2,3,4,5,6,7,8,9"

Public Function GetRndStr()

    Dim aryALP() As String
    Dim aryNUM() As String
    aryALP = Split(ALP, ",")
    aryNUM = Split(bNUM, ",")
    GetRndStr = aryALP(getRnd(0, 23)) & aryNUM(getRnd(0, 9)) & aryNUM(getRnd(0, 9)) & aryNUM(getRnd(0, 9)) & aryNUM(getRnd(0, 9)) & aryNUM(getRnd(0, 9)) & aryNUM(getRnd(0, 9)) & aryNUM(getRnd(0, 9)) & aryNUM(getRnd(0, 9)) & aryNUM(getRnd(0, 9)) & aryNUM(getRnd(0, 9))
End Function

Private Function getRnd(ByVal lowerbound As Integer, ByVal upperbound As Integer)

    getRnd = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
End Function

Sub 採番します_Click()

    Dim tarCell As Range
    If Cells(6, 3) = "" Then
        Set tarCell = Cells(6, 3)
    Else
      Set tarCell = Cells(Rows.Count, 3).End(xlUp).Offset(1)
    End If

    Randomize

    Dim aryALP() As String
    Dim aryNUM() As String

    aryALP = Split(ALP, ",")
    aryNUM = Split(bNUM, ",")

    Dim NUM As String
    Do
        NUM = aryALP(getRnd(0, 23)) & "-" & aryNUM(getRnd(0, 9)) & aryNUM(getRnd(0, 9)) & aryNUM(getRnd(0, 9)) & aryNUM(getRnd(0, 9)) & aryNUM(getRnd(0, 9)) & "-" & aryNUM(getRnd(0, 9)) & aryNUM(getRnd(0, 9)) & aryNUM(getRnd(0, 9)) & aryNUM(getRnd(0, 9)) & aryNUM(getRnd(0, 9))
        If Range(Cells(6, 3), tarCell).Find(NUM, LookAt:=xlWhole) Is Nothing Then
            tarCell.Value = NUM
            Exit Do
        End If
    Loop
End Sub

（ＭＳＣＬ） 2019/05/22(水) 17:44

ふむ、文字列だったのですね。ならば、こんな風にもできますよ。（コードの判りやすさ優先）

 Sub test()
    Const ALP = "ABCDEFGHJKLMNPQRSTUVWXYZ"
    Dim tarCell As Range
    Dim cw As String
    Dim iNum As Long

    If Cells(6, 3) = "" Then
        Set tarCell = Cells(6, 3)
    Else
        Set tarCell = Cells(Rows.Count, 3).End(xlUp).Offset(1)
    End If

    iNum = 1

    While 0 < iNum
        cw = Mid(ALP, WorksheetFunction.RandBetween(1, Len(ALP)), 1) & _
            "-" & Format(WorksheetFunction.RandBetween(0, 99999), "00000") & _
            "-" & Format(WorksheetFunction.RandBetween(0, 99999), "00000")
        iNum = WorksheetFunction.CountIf(Range("A:A"), cw)
    Wend

    tarCell.Value = cw
 End Sub
（???） 2019/05/22(水) 18:07

あぁ、
？？？さん、なんか、とてもスッキリしてますね…

iNum = 1

While 0 < iNum

が相変わらず理解できてませんが(苦笑)。

Rangeは『"C:C"』ですかね…

たびたび、ありがとうございます。利用させていただきます。
（ＭＳＣＬ） 2019/05/22(水) 18:24

ＭＳＣＬさんのコードをもとに改修してみました。
せっかくGetRndStr関数を作成しているのに、それを利用していないのはもったいない。

 Option Explicit
 '------------------------
Public Function GetRndStr()
    Const ALP As String = "ABCDEFGHJKLMNPQRSTUVWXYZ"
    GetRndStr = Mid(ALP, getRnd(1, Len(ALP)), 1) & Format(getRnd(0@, 9999999999@), "-00000-00000")
End Function
 '------------------------
Private Function getRnd(ByVal lowerbound As Currency, ByVal upperbound As Currency) As Currency
    getRnd = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
End Function
 '------------------------
Sub 採番します_Click()
    Dim tarCell As Range
    If Cells(6, 3) = "" Then
        Set tarCell = Cells(6, 3)
    Else
      Set tarCell = Cells(Rows.Count, 3).End(xlUp).Offset(1)
    End If
    Randomize
    Dim RndStr As String

    Do
        RndStr = GetRndStr()
        If Range(Cells(6, 3), tarCell).Find(RndStr, LookAt:=xlWhole) Is Nothing Then
            tarCell.Value = RndStr
            Exit Do
        End If
    Loop
End Sub

（hatena） 2019/05/22(水) 20:00

CountIfの対象がC列に変わっていたのを見落としました。失礼しました。

while文を使っているのは、生成した文字列が既に何個あるか（あっても1つですが）をチェックし、0個だったら採用、というロジックだからです。そして、ループ前に1にしているのは、整数型変数のデフォルト値は0のため、初回は文字列を作る前に終わってしまうからです。初期値を0以外にすることで、必ず1回は文字列生成させている訳ですね。

重複判定は、普通に考えると、今までに生成した文字列全てと一致するかForループ等で順次比較するのですが、インタプリンタでループするより、Excelの内部機能で文字列を探す方が簡単で速いです。（Findだと文字列検索1回ですし、CountIfだと何件一致するかカウント1回です）

隠居じーさんさんのロジックは、辞書化することで、ループして比較する時間を無くしています。ただし、辞書を作る時間がかかってしまうので、速度的には不利ですね。

ＭＳＣＬさんのロジックの場合、GetRndStrからgetRndを呼んでいますが、これをGetRndStrとGetRndNumのように、文字列と数字の2つの関数に分けて、更に桁数を引数とすれば、汎用的になって判りやすくなります。更に進めると、GetRndを1つだけ用意し、選択肢の文字列と桁数の2つを引数にすれば、共通関数1つで済みますね。以下のように使いますが、これなら判りやすいと思いますよ。

 cw = GetRnd(ALP, 1) & "-" & GetRnd(NUM, 5) & "-" & GetRnd(NUM, 5)
（???） 2019/05/23(木) 09:37

hatenaさん、たびたび、ていねいにありがとうございます。
？？？さん、詳しい解説、助かります。C列の件は、つまらない指摘ですみません。

今回もまた、たくさん勉強させて頂きました。
私は、まだまだ勉強しなきゃ…ですね…。ありがとうございました。
（ＭＳＣＬ） 2019/05/23(木) 10:27

コメント返信：

[ 一覧(最新更新順) ]

[[20190522114232]] 『10桁のランダムな数字をそれまでに発生していない』（ＭＳＣＬ） ページの最後に飛ぶ

[[20190522114232]]　『10桁のランダムな数字をそれまでに発生していない』（ＭＳＣＬ）　ページの最後に飛ぶ