Can this Code be Condensed
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
"Paul Black" 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)
End If
.... etc.
Thanks in Advance.
All the Best.
Paul
On Nov 18, 1:57 pm, Joel wrote:
Paul: Not sure what you are doing this time. If you have 6 numbers (A to F)
and you are looking at the 1st digits then the maximum sum of the 1st digits
is 9 + 8 + 7 + 6 + 5 + 4 = 39. Your code only has 9 instead of 39
I changed
from:
ActiveCell.Offset(0, 0).Value = "First Digits ="
to:
ActiveCell.Offset(0, 0).Value = "Sum First Digits ="
Option Explicit
Option Base 1
Sub First_Digits()
Dim Start As Double
Start = Timer
Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim D As Integer
Dim E As Integer
Dim F As Integer
Dim i As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nType(39) As Double
Dim sum As Long
Application.ScreenUpdating = False
Range("B4").Select
Dim results(49) As Long
nMinA = 1
nMaxF = 49
For i = 1 To 39
nType(i) = 0
Next i
For i = nMinA To 9
results(i) = i
Next i
For i = 10 To nMaxF
results(i) = Int(i \ 10)
Next i
For A = nMinA To nMaxF - 5
For B = A + 1 To nMaxF - 4
For C = B + 1 To nMaxF - 3
For D = C + 1 To nMaxF - 2
For E = D + 1 To nMaxF - 1
For F = E + 1 To nMaxF
sum = results(A) + results(B) + results(C) + _
results(D) + results(E) + results(F)
nType(sum) = nType(sum) + 1
Next F
Next E
Next D
Next C
Next B
Next A
For i = 1 To 39
ActiveCell.Offset(0, 0).Value = "Sum First Digits ="
ActiveCell.Offset(0, 1).Value = i
ActiveCell.Offset(0, 2).Value = nType(i)
ActiveCell.Offset(1, 0).Select
Next i
ActiveCell.Offset(0, 0).Value = "Total Combinations Produced"
sum = 0
For i = 1 To 39
sum = sum + nType(i)
Next i
ActiveCell.Offset(0, 2).Value = sum
ActiveCell.Offset(2, 0) = "This Program Took " & _
Format(((Timer - Start) / 24 / 60 / 60), "hh:mm:ss") & _
" To Process"
Range("B68").Select
Application.ScreenUpdating = True
End Sub
"Paul Black" wrote:
Thanks Joel,
The code now is ...
Option Explicit
Option Base 1
Sub First_Digits()
Dim Start As Double
Start = Timer
Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim D As Integer
Dim E As Integer
Dim F As Integer
Dim i As Integer
Dim nMinA As Integer
Dim nMaxF As Integer
Dim nType(9) As Double
Dim sum As Long
Application.ScreenUpdating = False
Range("B4").Select
Dim results(49) As Long
nMinA = 1
nMaxF = 49
For i = nMinA To 9
nType(i) = 0
results(i) = i
Next i
For i = 10 To nMaxF
nType(i) = 0
results(i) = Int(i \ 10)
Next i
For A = nMinA To nMaxF - 5
For B = A + 1 To nMaxF - 4
For C = B + 1 To nMaxF - 3
For D = C + 1 To nMaxF - 2
For E = D + 1 To nMaxF - 1
For F = E + 1 To nMaxF
sum = results(A) + results(B) + results(C) + results(D) +
results(E) + results(F)
nType(sum) = nType(sum) + 1
Next F
Next E
Next D
Next C
Next B
Next A
For i = 1 To 9
ActiveCell.Offset(0, 0).Value = "First Digits ="
ActiveCell.Offset(0, 1).Value = i
ActiveCell.Offset(0, 2).Value = nType(i)
ActiveCell.Offset(1, 0).Select
Next i
ActiveCell.Offset(0, 0).Value = "Total Combinations Produced"
sum = 0
For i = 1 To 9
sum = sum + nType(i)
Next i
ActiveCell.Offset(0, 2).Value = sum
ActiveCell.Offset(2, 0) = "This Program Took " & _
Format(((Timer - Start) / 24 / 60 / 60), "hh:mm:ss") & " To Process
"
|