Numbers to Lexicographic Index Number (CSN)

  • Thread starter Thread starter Paul Black
  • Start date Start date
P

Paul Black

Hi everyone,

I have the code ...

Option Explicit

Dim A As Integer, B As Integer, C As Integer, D As Integer, E As
Integer, F As Integer
Dim nVal As Double, nLex As Double

Sub LexToNumbers()
nVal = Range("A1").Value
nLex = 0
For A = 1 To 44
For B = A + 1 To 45
For C = B + 1 To 46
For D = C + 1 To 47
For E = D + 1 To 48
For F = E + 1 To 49
nLex = nLex + 1
If nLex = nVal Then
Range("B1").Value = A
Range("C1").Value = B
Range("D1").Value = C
Range("E1").Value = D
Range("F1").Value = E
Range("G1").Value = F
Exit Sub
End If
Next F
Next E
Next D
Next C
Next B
Next A
End Sub

.... which calculates and produces the 6 numbers associated with the
Lexicographic Index Number entered in cell "A1".
How can I get the Lexicographic Index Number from the numbers entered
in cells "B1:G1" please.
Tom Ogilvy produced the following code which might be of help :-

Function LexNumber()
LexNumber = False
a = IIf(44 - Range("O14").Value > 0, _
Application.Combin(49 - _
Range("O14").Value, 6), 0)
b = IIf(45 - Range("P14").Value > 0, _
Application.Combin(49 - _
Range("P14").Value, 5), 0)
c = IIf(46 - Range("Q14").Value > 0, _
Application.Combin(49 - _
Range("Q14").Value, 4), 0)
d = IIf(47 - Range("R14").Value > 0, _
Application.Combin(49 - _
Range("R14").Value, 3), 0)
e = IIf(48 - Range("S14").Value > 0, _
Application.Combin(49 - _
Range("S14").Value, 2), 0)
f = IIf(49 - Range("T14").Value > 0, _
Application.Combin(49 - _
Range("T14").Value, 1), 0)
lNumber = Application.Combin(49, 6) _
- a - b - c - d - e - f
If lNumber > 22500 And lNumber < 50000 Then
LexNumber = True
End if
End Function

Thanks in Advance.
All the Best.
Paul
 
Function NumbersToLex()
A = IIf(44 - Range("B1").Value > 0, _
Application.Combin(49 - _
Range("O14").Value, 6), 0)
B = IIf(45 - Range("C1").Value > 0, _
Application.Combin(49 - _
Range("P14").Value, 5), 0)
C = IIf(46 - Range("D1").Value > 0, _
Application.Combin(49 - _
Range("Q14").Value, 4), 0)
D = IIf(47 - Range("E1").Value > 0, _
Application.Combin(49 - _
Range("R14").Value, 3), 0)
E = IIf(48 - Range("F1").Value > 0, _
Application.Combin(49 - _
Range("S14").Value, 2), 0)
F = IIf(49 - Range("G1").Value > 0, _
Application.Combin(49 - _
Range("T14").Value, 1), 0)
NumbersToLex = Application.Combin(49, 6) _
- A - B - C - D - E - F
End Function

seems to do it, use in a spreadsheet in any cell thus:
NumbersToLex()
I suspect the numbers will have to be in ascending order first though.
--
p45cal

ps. another longwinded way is to make small adjustments to your code:

Sub NumbersToLex2()
nLex = 0
For A = 1 To 44
For B = A + 1 To 45
For C = B + 1 To 46
For D = C + 1 To 47
For E = D + 1 To 48
For F = E + 1 To 49
nLex = nLex + 1
If Range("B1").Value = A And Range("C1").Value = B And Range("D1").Value = C
And Range("E1").Value = D And Range("F1").Value = E And Range("G1").Value = F
Then
nVal = nLex
Range("H1") = nVal
Exit Sub
End If
Next F
Next E
Next D
Next C
Next B
Next A
End Sub

I say long winded 'cos it could take a llllooonnnggg time.
p45cal
______
 
a small mistake; I said:
use in a spreadsheet in any cell thus:
NumbersToLex()

it should have been:
use in a spreadsheet in any cell thus:
=NumbersToLex()
 
Thanks for the reply p45cal,

I really wanted it in a seperate sub so I could attach each of the
subs to a button please.

Thanks in Advance.
All the Best.
Paul
 
Thanks for the reply p45cal,

I really wanted the seperate sub which is great.
I put in numbers 44 45 46 47 48 49 and it took ages to calculate
13983816.
Is it quicker than calling the function from the sub, if so, how do I
do I call the function please?.

Thanks in Advance.
All the Best.
Paul
 
I put in numbers 44 45 46 47 48 49 and it took ages to calculate
13983816.
Click to expand...

Hi. As a side note, in Combinations, what you are asking for is the Rank of
a Subset.
Your initial code "Sub LexToNumbers()" is trying to "UnRank" the subset.
Code is usually written much different than the above by taking advantage of
certain properties.
For example, the number 1 can only occur in so many subsets.
Search for something like "RankKSubset" where you must supply the initial
size of your array. (ie 49 as the first item)

t = Timer
Debug.Print RankKSubset(49, 44, 45, 46, 47, 48, 49)
Debug.Print Timer - t

returns
13983816
0 (ie seconds)
 
Sub NumbersToLex()
A = IIf(44 - Range("B1").Value > 0, _
Application.Combin(49 - _
Range("B1").Value, 6), 0)
B = IIf(45 - Range("C1").Value > 0, _
Application.Combin(49 - _
Range("C1").Value, 5), 0)
C = IIf(46 - Range("D1").Value > 0, _
Application.Combin(49 - _
Range("D1").Value, 4), 0)
D = IIf(47 - Range("E1").Value > 0, _
Application.Combin(49 - _
Range("E1").Value, 3), 0)
E = IIf(48 - Range("F1").Value > 0, _
Application.Combin(49 - _
Range("F1").Value, 2), 0)
F = IIf(49 - Range("G1").Value > 0, _
Application.Combin(49 - _
Range("G1").Value, 1), 0)
Range("A1") = Application.Combin(49, 6) _
- A - B - C - D - E - F
End Sub

was almost instantaneous for me.
 
Thanks everyone for your time and help, especially Tom, it works like
a dream.

All the Best.
Paul
 
call the function in a sub thus:

Sub test()
Range("H1") = LexToNumber
End Sub

t-timer was zero here too Tom!
 
Thanks everyone for your time and help.
It all works great and VERY fast.
I went with Tom's sub in the end. One interesting point though, when I
"Dimmed" the variables it gave me an overflow 6 error.
Is there better coding for ...

Option Explicit

Dim A As Integer, B As Integer, C As Integer, D As Integer, E As
Integer, F As Integer
Dim nVal As Double, nLex As Double

Sub LexToNumbers()
nVal = Range("A1").Value
nLex = 0
For A = 1 To 44
For B = A + 1 To 45
For C = B + 1 To 46
For D = C + 1 To 47
For E = D + 1 To 48
For F = E + 1 To 49
nLex = nLex + 1
If nLex = nVal Then
Range("B1").Value = A
Range("C1").Value = B
Range("D1").Value = C
Range("E1").Value = D
Range("F1").Value = E
Range("G1").Value = F
Exit Sub
End If
Next F
Next E
Next D
Next C
Next B
Next A
End Sub

.... to make it more efficient?.

Thanks in Advance.
All the Best.
Paul
 
Hi. Just for Gee Wiz, here is something one would think Excel could not do.
Suppose you had a set of 300, instead of 49.
Suppose you also picked a random size of numbers, say 15.

{4, 15, 31, 53, 71, 80, 109, 122, 140, 152, 173, 175, 196, 198, 220}

Without changing the code, the above numbers are the
1,234,567,890,123,456,789,012,345
th item in the list.

Sub Demo()
Dim T
T = Timer
Debug.Print NF(RankKSubset(300, 4, 15, 31, 53, 71, 80, 109, 122, 140, 152,
173, 175, 196, 198, 220))
Debug.Print Timer - T
End Sub

Returns
1,234,567,890,123,456,789,012,345
0 (Seconds)

(Large number chosen for its pattern as a visual check)
Just a topic I find interesting. :>o
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Help with a Formula Within a Function Please 5
Count Specific Total Numbers from a Set 22
Modify working code to expand the output. 5
Transfer array element offset value to a matched value 3
Change_Event not responding to change made by formula. 11
Calculating Gaps Between Numbers 31
Conflict 8
Code to insert a coma 26

Back
Top