RE: Scramble Number

[twildone]

RE: Scramble Number

Hi....I am trying to generate 10 unique numbers where each number has 9 digits ranging from 0-9. Each digit can only appear once in any placeholder, that is, only once in any row or column. I was able to randomize the digits within each column using rand() and randbetween but the problem I am having is to have them randomized across the columns. Any suggestions or help is greatly appreciated...Thanks in advance.

 

[shg]

Re: Scramble Number

You mean like a Latin square?

Row\Col

A​

B​

C​

D​

E​

F​

G​

H​

I​

J​

K​

L​

M​

N​

1​

0​

1​

2​

3​

4​

5​

6​

7​

8​

9​

A1:J1: Input

0123456789

M1: =TEXT(SUMPRODUCT(A1:J1, 10^{9,8,7,6,5,4,3,2,1,0}), "0000000000")

2​

1​

2​

3​

4​

5​

6​

7​

8​

9​

0​

B2: =MOD(A2+1, 10)

1234567890

3​

2​

3​

4​

5​

6​

7​

8​

9​

0​

1​

A2:A10: Input

2345678901

4​

3​

4​

5​

6​

7​

8​

9​

0​

1​

2​

3456789012

5​

4​

5​

6​

7​

8​

9​

0​

1​

2​

3​

4567890123

6​

5​

6​

7​

8​

9​

0​

1​

2​

3​

4​

5678901234

7​

6​

7​

8​

9​

0​

1​

2​

3​

4​

5​

6789012345

8​

7​

8​

9​

0​

1​

2​

3​

4​

5​

6​

7890123456

9​

8​

9​

0​

1​

2​

3​

4​

5​

6​

7​

8901234567

10​

9​

0​

1​

2​

3​

4​

5​

6​

7​

8​

9012345678

 

[shg]

Re: Scramble Number

If you want to generate them randomly,

Row\Col

A​

B​

C​

D​

E​

F​

G​

H​

I​

J​

K​

L​

1​

8​

1​

6​

5​

4​

3​

2​

0​

9​

7​

A1:J10: {=RandLatin(TRUE)-1}

2​

7​

8​

4​

2​

9​

1​

6​

3​

0​

5​

3​

5​

7​

9​

6​

0​

8​

4​

1​

3​

2​

4​

9​

4​

8​

3​

7​

6​

1​

2​

5​

0​

5​

2​

5​

0​

4​

3​

7​

9​

8​

1​

6​

6​

0​

9​

7​

1​

5​

4​

8​

6​

2​

3​

7​

3​

0​

5​

8​

2​

9​

7​

4​

6​

1​

8​

4​

6​

1​

0​

8​

2​

3​

5​

7​

9​

9​

1​

3​

2​

7​

6​

0​

5​

9​

4​

8​

10​

6​

2​

3​

9​

1​

5​

0​

7​

8​

4​

Function RandLatin(Optional bVolatile As Boolean = False) As Long()
  ' shg 2013

  ' UDF only
  ' Requires adRandLong()

  ' Returns a random Latin square of size n with symbols 1 to n
  ' (by shuffling the symbols, then the rows, then the columns)
  ' to the calling range

  ' e.g., in A1:E5, {=RandLatin()}

  ' All such squares generated in this fashion are members (I think)
  ' of the same isotopy class, so it doesn't generate all possibilities.

  Dim aiInp()       As Long
  Dim aiOut()       As Long
  Dim aiRnd()       As Long
  Dim n             As Long
  Dim i             As Long
  Dim j             As Long

  If bVolatile Then Application.Volatile

  With Application.Caller
    n = IIf(.Rows.Count > .Columns.Count, .Rows.Count, .Columns.Count)
  End With

  ReDim aiInp(1 To n, 1 To n)
  ReDim aiOut(1 To n, 1 To n)

  ' shuffle the symbols
  aiRnd = aiRandLong(1, n)
  For i = 1 To n
    For j = 1 To n
      aiInp(i, j) = aiRnd(((i + j - 2) Mod n) + 1)
    Next j
  Next i

  ' shuffle the rows
  aiRnd = aiRandLong(1, n)
  For i = 1 To n
    For j = 1 To n
      aiOut(i, j) = aiInp(aiRnd(i), j)
    Next j
  Next i

  aiInp = aiOut

  ' shuffle the columns
  aiRnd = aiRandLong(1, n)
  For i = 1 To n
    For j = 1 To n
      aiOut(j, i) = aiInp(j, aiRnd(i))
    Next j
  Next i

  RandLatin = aiOut
End Function

Public Function aiRandLong(iMin As Long, _
                           iMax As Long, _
                           Optional ByVal n As Long = -1, _
                           Optional bVolatile As Boolean = False) As Long()
  ' shg 2008
  ' UDF or VBA

  ' Fisher-Yates shuffle
  ' Returns a 1-based array of n unique Longs between iMin and iMax inclusive

  Dim aiSrc()       As Long     ' array of numbers iMin to iMax
  Dim iSrc          As Long     ' index to aiSrc
  Dim iTop          As Long     ' decreasing upper bound for next selection

  Dim aiOut()       As Long     ' output array
  Dim iOut          As Long     ' index to aiOut

  If bVolatile Then Application.Volatile True

  If n < 0 Then n = iMax - iMin + 1
  If iMin > iMax Or n > (iMax - iMin + 1) Or n < 1 Then Exit Function

  ReDim aiSrc(iMin To iMax)
  ReDim aiOut(1 To n)

  ' init iSrc
  For iSrc = iMin To iMax
    aiSrc(iSrc) = iSrc
  Next iSrc

  iTop = iMax
  For iOut = 1 To n
    ' Pick a number in aiSrc between 1 and iTop, copy to output,
    ' replace with the number at iTop, decrement iTop
    iSrc = Int((iTop - iMin + 1) * Rnd) + iMin
    aiOut(iOut) = aiSrc(iSrc)
    aiSrc(iSrc) = aiSrc(iTop)
    iTop = iTop - 1
  Next iOut

  aiRandLong = aiOut
End Function