Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 124
Default one doozie of a macro req'd please...

Is it OK if a "non-guy" answers your question <g ?

Since your numbers will range from 1 to 34, in a 50 cell range there must be either blanks or
duplicates. With 34 different numbers, you will get 561 pairs (01-02 to 33-34), 5984 triplets
(01-02-03 to 32-33-34), and 46,376 quadruplets (01-02-03-04 to 31-32-33-34).

The macro generates the sets as a single number. The appearance of 2, 3, or 4 numbers is
achieved by formatting, so there are leading zeroes for numbers 1 through 9.

I'm curious: what is the purpose of all of this? Is this some kind of gambling problem?


Option Explicit

Sub GetCombos()
Dim i As Long
Dim j As Long
Dim k As Long
Dim m As Long
Dim n1 As Long
Dim n2 As Long
Dim n3 As Long
Dim n4 As Long
Dim Rng As Range
Dim v As Variant
Dim Singles() As Double
Dim Pairs() As Double
Dim Triples() As Double
Dim Quads() As Double

Const Multiplier As Long = 100

Set Rng = Range("A1:E10")
ReDim Singles(1 To Rng.Cells.Count)

'get the unique numbers from the range into Singles()
n1 = 0
For i = 1 To Rng.Cells.Count
v = Rng.Cells(i).Value
If IsEmpty(v) Then
'skip this cell
ElseIf IsNumeric(v) Then
'MATCH will give an error if it's a new number
If IsError(Application.Match(v, Singles(), 0)) Then
n1 = n1 + 1
Singles(n1) = v
End If
End If
Next i

ReDim Preserve Singles(1 To n1) 'max is 34

i = Application.Combin(n1, 2) 'max is 561
ReDim Pairs(1 To i, 1 To 1)

i = Application.Combin(n1, 3) 'max is 5984
ReDim Triples(1 To i, 1 To 1)

i = Application.Combin(n1, 4)
ReDim Quads(1 To i, 1 To 1) 'max is 46,376

n2 = 0
n3 = 0
n4 = 0

For i = 1 To n1
For j = i + 1 To n1
n2 = n2 + 1
Pairs(n2, 1) = Singles(i) * Multiplier + Singles(j)

For k = j + 1 To n1
n3 = n3 + 1
Triples(n3, 1) = Pairs(n2, 1) * Multiplier + Singles(k)

For m = k + 1 To n1
n4 = n4 + 1
Quads(n4, 1) = Triples(n3, 1) * Multiplier + Singles(m)
Next m
Next k
Next j
Next i

Range("G1:I1").Value = Array("Pairs", "Triples", "4's")

With Range("G2").Resize(n2)
.Value = Pairs()
.NumberFormat = "00-00"
End With

With Range("H2").Resize(n3)
.Value = Triples()
.NumberFormat = "00-00-00"
End With

With Range("I2").Resize(n4)
.Value = Quads()
.NumberFormat = "00-00-00-00"
End With
End Sub



On 30 Jul 2003 12:36:29 -0700, (ste mac) wrote:

Hi Guys, l am new to this news group and was hoping somebody could
help me out with some macro code...
Picture the scene, l have in column A (rows 1 thru 10)a set of
ascending numbers upto a maximum of 10 digits (there could be only 6,
or 8 or 9 etc)...
then the same in column B and C and D and finally E...so it looks
something like this:

ColA Col B Col C Col D Col E Ex: generated pairs triples
quads

f
There can be as many as 10 digits in any column and as low a 5
digits...
now, what l would really like to do is list all the unique 'pairs' of
digits that could be produced by all the digits in the range i.e
1-2...1-3...1-4 etc all the way up to 33-34... if this is not hard
enough on its own, l need the triples! i.e 1-2-3...1-2-4...1-2-5 etc
and to make matters even tougher l really need to quads to finish it
off (oh no!!)yep! i.e 1-2-3-4...1-2-3-5... 1-2-3-6...1-18-19-32 etc
etc...
l know that quads alone will produce something in the region of 15 to
20,000 records...so even though l am asking a lot, l would like the
results to be generated down a single column for the 'pairs' and
another for the 'triples' and finally one for the 'quads'...
l have to change the values in the columns once they have all been
generated to run the process again with a different set of numbers in
the columns, also l need something inbetween the generated numbers ie
a "-"...The numbers in the columns will be from 1(min) to 34(max)...
tough one? (nightmare!)

Thanks in advance for any help gratefully recieved...

seeya ste


  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 130
Default one doozie of a macro req'd please...

C'mon, Myrna. Some of us--even some of your vintage and even somewhat
older <g--think "guy" is currently a non-gender-specific generic term.
So yes, you should feel included.

Alan Beban

Myrna Larson wrote:
Is it OK if a "non-guy" answers your question <g ? [snip]


  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 117
Default one doozie of a macro req'd please...

Myrna, I am more than pleased that a "non-guy" answered my question,
the macro you have written is perfect! all I can say is thankyou very
much...
You are right to assume that this was part lotto problem, it is just
something I mess around with in my spare time...but as I am no VB
expert and some code is just too difficult to write without the help
of you "non guys" and of course real guys he he he he...
once again thankyou...


seeya ste
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
 
Posts: 117
Default one doozie of a macro req'd please...

You can bet on it Myrna....cheers...
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
A REQ'D iNSTALLATION FILE ZF561407.CAB COULD NOT BE FOUND Jerry Setting up and Configuration of Excel 0 November 29th 07 11:18 PM
Formula Req'd - Autofilter limitation workaround Maurice Excel Worksheet Functions 4 September 12th 06 11:06 PM
date formula assistance req'd Bri Excel Worksheet Functions 5 May 5th 06 10:17 PM
Linking worksheet functions and arrays - Doozie gsimmons2005 Excel Discussion (Misc queries) 1 August 17th 05 10:32 PM
one doozie of a macro req'd please... Tom Ogilvy Excel Programming 1 July 31st 03 05:49 AM


All times are GMT +1. The time now is 07:16 PM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"