Can this Code be Condensed
Thanks for the reply and detailed explanation, it is appreciated.
I have amended the code ...
Option Explicit
Option Base 1
Private FirstDigits(6) As Long
Private Counts(9) As Integer
Private Map(11) As Long
Sub First_Digit()
Dim A As Integer, B As Integer, C As Integer, _
D As Integer, E As Integer, F As Integer ' Ball Number
Dim n As Long
Dim Total As Long
Dim First(49)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Map(1) = 111111
Map(2) = 211110
Map(3) = 221100
Map(4) = 222000
Map(5) = 311100
Map(6) = 321000
Map(7) = 330000
Map(8) = 411000
Map(9) = 420000
Map(10) = 510000
Map(11) = 600000
For n = 1 To 11
Counts(n) = 0
Next n
For n = 1 To 49
If n <= 9 Then
First(n) = n
Else
First(n) = Int(n / 10)
End If
Next n
For A = 1 To 44
FirstDigits(1) = First(A)
For B = A + 1 To 45
FirstDigits(2) = First(B)
For C = B + 1 To 46
FirstDigits(3) = First(C)
For D = C + 1 To 47
FirstDigits(4) = First(D)
For E = D + 1 To 48
FirstDigits(5) = First(E)
For F = E + 1 To 49
FirstDigits(6) = First(F)
UpdateCounts
Next F
Next E
Next D
Next C
Next B
Next A
Range("A1").Select
For n = 1 To 11
Total = Total + Counts(n)
ActiveCell.Offset(0, 0).Value = Map(n)
ActiveCell.Offset(0, 1).Value = Format(Counts(n), "#,0")
ActiveCell.Offset(1, 1).Value = Format(Total, "#,0")
ActiveCell.Offset(1, 0).Select
Next n
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Private Sub UpdateCounts()
Dim Cnt(1 To 9) As Long
Dim n As Long
Dim i As Long
Dim j As Long
Dim temp As Long
Dim max As Long
Dim pattern As Double
For n = 1 To 6
Cnt(FirstDigits(n)) = Cnt(FirstDigits(n)) + 1
Next n
'sort cnt
pattern = 0
For i = 1 To 6
For j = (i + 1) To 9
If Cnt(j) Cnt(i) Then
temp = Cnt(j)
Cnt(j) = Cnt(i)
Cnt(i) = temp
End If
Next j
pattern = pattern * 10 + Cnt(i)
Next i
For n = 1 To UBound(Map)
If Map(n) = pattern Then
Counts(n) = Counts(n) + 1
Exit For
End If
Next n
End Sub
.... but get a subscript out of range, Run-time error 9 on line ...
Counts(n) = 0
Thanks in Advance.
All the Best.
Paul
On Nov 19, 11:40 am, Joel wrote:
Answer to questions.
1) Your code has Option Base 1 which means arrays start at 1 (not 0).
Are the lines ...
2) Private Counts(11) As Long
Counts technically go from the digit 0 to the digit 9. We eliminated zero
from the digits with the last update. So we have only 1 to 9. Therrefore
Counts should be Counts(9). It can also be changed to an Integer instead of
a long.
3) Private Map(11) As Long
Map(11) as Long is correct. It is the number of patterns you are looking
for starting at a count of 1.
Long (long integer) variables are stored as signed 32-bit (4-byte) numbers
ranging in value from -2,147,483,648 to 2,147,483,647. The type-declaration
character for Long is the ampersand (&).
4) n in this case below should be the same size as patttern
For n = 1 To 11 map
Counts(n) = 0
Next n
.... and ...
For n = 1 To 11
Total = Total + Counts(n)
5) Cnt is the number of 1st digitas which is 1 to 9
Dim Cnt(1 To 9) As Long
.... and ...
For j = (i + 1) To 9
6) n is a local variable whose scope does not need to be global (used by
both main routine and sub function). There is no need to make n global
(public). Making it global may increase the run time of the program because
it may use a longer address to find the variable.
The scope of a variable life is where it is defined. Public variable a
regonized everywhere. Local variables are recognized only in the routine
where they are used.
.... correct please.
I find it confusing that there is a variable "n" in both Subs though,
does this have to be the case.
7) The line below where the are presently located. the variable A is not
defined until the For statement is executed.
Also, can the lines ...
FirstDigits(1) = First(A)
.... etc be put before the "For ... Next" loops in order to speed the
code up, similar to what Dana used previously?.
Thanks in Advance.
All the Best.
Paul
"Paul Black" wrote:
Outstanding Joel, it works like a dream.
Here is the finished code including the new Mappings and adjusted
parameters ...
Option Explicit
Option Base 1
Private FirstDigits(6) As Long
Private Counts(11) As Long
Private Map(11) As Long
Sub First_Digit()
Dim A As Integer, B As Integer, C As Integer, _
D As Integer, E As Integer, F As Integer ' Ball Number
Dim n As Long
Dim Total As Long
Dim First(49)
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Map(1) = 111111
Map(2) = 211110
Map(3) = 221100
Map(4) = 222000
Map(5) = 311100
Map(6) = 321000
Map(7) = 330000
Map(8) = 411000
Map(9) = 420000
Map(10) = 510000
Map(11) = 600000
For n = 1 To 11
Counts(n) = 0
Next n
For n = 1 To 49
If n <= 9 Then
First(n) = n
Else
First(n) = Int(n / 10)
End If
Next n
For A = 1 To 44
FirstDigits(1) = First(A)
For B = A + 1 To 45
FirstDigits(2) = First(B)
For C = B + 1 To 46
FirstDigits(3) = First(C)
For D = C + 1 To 47
FirstDigits(4) = First(D)
For E = D + 1 To 48
FirstDigits(5) = First(E)
For F = E + 1 To 49
FirstDigits(6) = First(F)
UpdateCounts
Next F
Next E
Next D
Next C
Next B
Next A
Range("A1").Select
For n = 1 To 11
Total = Total + Counts(n)
ActiveCell.Offset(0, 0).Value = Map(n)
ActiveCell.Offset(0, 1).Value = Format(Counts(n), "#,0")
ActiveCell.Offset(1, 1).Value = Format(Total, "#,0")
ActiveCell.Offset(1, 0).Select
Next n
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Private Sub UpdateCounts()
Dim Cnt(1 To 9) As Long
Dim n As Long
Dim i As Long
Dim j As Long
Dim temp As Long
Dim max As Long
Dim pattern As Double
For n = 1 To 6
Cnt(FirstDigits(n)) = Cnt(FirstDigits(n)) + 1
Next n
'sort cnt
pattern = 0
For i = 1 To 6
For j = (i + 1) To 9
If Cnt(j) Cnt(i) Then
temp = Cnt(j)
Cnt(j) = Cnt(i)
Cnt(i) = temp
End If
Next j
pattern = pattern * 10 + Cnt(i)
Next i
For n = 1 To UBound(Map)
If Map(n) = pattern Then
Counts(n) = Counts(n) + 1
Exit For
End If
Next n
End Sub
Are the lines ...
Private Counts(11) As Long
Private Map(11) As Long
.... and ...
For n = 1 To 11
Counts(n) = 0
Next n
.... and ...
For n = 1 To 11
Total = Total + Counts(n)
.... and ...
Dim Cnt(1 To 9) As Long
.... and ...
For j = (i + 1) To 9
.... correct please.
I find it confusing that there is a variable "n" in both Subs though,
does this have to be the case.
Also, can the lines ...
FirstDigits(1) = First(A)
.... etc be put before the "For ... Next" loops in order to speed the
code up, similar to what Dana used previously?.
Thanks in Advance.
All the Best.
Paul.
On Nov 18, 4:12 pm, Joel wrote:
Your maps have only 5 digits instead of 6???? Add 1 digit
Map(1) = 21111
Map(2) = 22110
Map(3) = 22200
Map(4) = 31110
Map(5) = 32100
Map(6) = 33000
Map(7) = 41100
Map(8) = 42000
Map(9) = 51000
Map(10) = 60000
"PaulBlack" wrote:
Hi Joel,
The code ...
Option Explicit
Option Base 1
Private FirstDigits(6) As Long
Private Counts(10) As Long
Private Map(10) As Long
Sub First_Digit()
Dim A As Integer, B As Integer, C As Integer, D As Integer, E As
Integer, F As Integer ' Ball Number
Dim n As Long
Dim Total As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Map(1) = 21111
Map(2) = 22110
Map(3) = 22200
Map(4) = 31110
Map(5) = 32100
Map(6) = 33000
Map(7) = 41100
Map(8) = 42000
Map(9) = 51000
Map(10) = 60000
For n = 1 To 10
Counts(n) = 0
Next n
For A = 1 To 44
FirstDigits(1) = Int(A / 10)
For B = A + 1 To 45
FirstDigits(2) = Int(B / 10)
For C = B + 1 To 46
FirstDigits(3) = Int(C / 10)
For D = C + 1 To 47
FirstDigits(4) = Int(D / 10)
For E = D + 1 To 48
FirstDigits(5) = Int(E / 10)
For F = E + 1 To 49
FirstDigits(6) = Int(F / 10)
UpdateCounts
Next F
Next E
Next D
Next C
Next B
Next A
Range("A1").Select
For n = 1 To 10
Total = Total + Counts(n)
ActiveCell.Offset(0, 0).Value = Map(n)
ActiveCell.Offset(0, 1).Value = Format(Counts(n), "#,0")
ActiveCell.Offset(1, 1).Value = Format(Total, "#,0")
ActiveCell.Offset(1, 0).Select
Next n
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Private Sub UpdateCounts()
Dim Cnt(0 To 4) As Long
Dim n As Long
Dim j As Long
Dim max As Long
Dim pattern As Long
For n = 1 To 6
Cnt(FirstDigits(n)) = Cnt(FirstDigits(n)) + 1
Next n
For n = 0 To 4
max = 0
For j = 0 To 4
If Cnt(j) Cnt(max) Then
max = j
End If
Next j
pattern = pattern * 10 + Cnt(max)
Cnt(max) = 0
Next n
For n = 1 To UBound(Map)
If Map(n) = pattern Then
Counts(n) = Counts(n) + 1
Exit For
End If
Next n
End Sub
.... works OK but assumes that the numbers 1 to 9 are double digit
numbers, so 1 to 9 is actually 01 to 09.
I would like to adapt this code so that the numbers 1 to 9 are
classed
as 1 to 9 NOT 01 to 09.
The answer should be something like ...
111111 = 203324 Combinations
211110 = 2336400 Combinations
221100 = 4374150 Combinations
222000 = 665500 Combinations
311100 = 2300760 Combinations
321000 = 2940300 Combinations
330000 = 163350 Combinations
411000 = 710160 Combinations
420000 = 217800 Combinations
510000 = 70224 Combinations
600000 = 1848 Combinations
Totals = 13983816 Combinations
.... please.
Basically, if the first digits are 1 to 9 then use the first digits 1
to 9 in the counts, otherwise use INT(A/10) etc.
Something like ...
For A = 1 To 44
If FirstDigits(1) <= 9 Then
FirstDigits(1) = FirstDigits(1)
Else
FirstDigits(1) = Int(A / 10)- Hide quoted text -
- Show quoted text -
|