Option Explicit
Dim RE As Object
Sub Start_routine()
Dim rng1 As Excel.Range
Dim rng2 As Excel.Range
Dim rng3 As Excel.Range
Dim rngT As Excel.Range
Dim rngR As Excel.Range
Dim L As Long
Set rng1 = [a1:a3]
Set rng2 = [b1]
Set rng3 = [c1:c3]
Set rng1 = Application.Union(rng1, rng2, rng3)
Set rngR = Nuovo_Range(ThisWorkbook)
For Each rng2 In rng1
For Each rngT In rng2
If Not IsEmpty(rngT.Value) Then
rngR.Offset(L) = rngT
L = L + 1
End If
Next
Next
Set RE = CreateObject("VBScript.RegExp")
Combina_Dic rngR.Parent.UsedRange, rngR
End Sub
Sub Combina_Dic( _
sC As Range, _
StartRng As Excel.Range)
'di Roberto Mensa - Nick r
Dim dic1 As Object
Dim L1 As Long, L2 As Long
Dim S1 As String, S2 As String
Dim v1 As Variant
Set dic1 = CreateObject("Scripting.dictionary")
L1 = sC.Count
For L2 = 1 To L1
dic1.Add sC(L2), ""
Debug.Print sC(L2)
S2 = S2 & sC(L1) & " "
Next
S2 = Trim(S2)
For Each v1 In dic1
For L2 = 1 To L1
S1 = v1 & " " & sC(L2)
dic1.Add S1, ""
Next
If S1 = S2 Then Exit For
Next
L2 = 0
For Each v1 In dic1
If Is_Unique_RE(CStr(v1)) Then
StartRng.Offset(L2) = v1
L2 = L2 + 1
End If
Next
End Sub
Function Is_Unique_RE(Testo As String) As Boolean
'di Roberto Mensa - Nick r
Dim M, s As String
RE.Global = True
RE.IgnoreCase = True
RE.Pattern = "\w+"
For Each M In RE.Execute(Testo)
RE.Pattern = "\b" & M & "\b"
If RE.test(s) Then
Exit Function
Else
s = s & " " & M
End If
Next
Is_Unique_RE = True
End Function
Function Nuovo_Range( _
Wb As Excel.Workbook, _
Optional Nome_base As _
String = "Res") As Excel.Range
'di Roberto Mensa - Nick r
Dim b
Set Nuovo_Range = Wb.Worksheets.Add.Range("A1")
Application.ScreenUpdating = False
On Error Resume Next
Do
Err.Clear
Nuovo_Range.Parent.Name = Nome_base & b
b = b + 1
Loop While Err
Application.ScreenUpdating = True
End Function
regards
r
Il mio ultimo lavoro ...
http://excelvba.altervista.org/blog/...ternative.html
"Randy" wrote:
> I wonder whether anyone is so inclined to offer their suggestion as to
> how one might accomplish the following...
>
> (A snippet of code for a macro is great by the way, if anyone thinks
> they might have an idea.) I'm using Excel 2007, and am at a sort of
> junior moderate level of proficiency with the VBA after a good number
> of years at it on a part-time basis.
>
>
> DEFINITION of issue:
> I would like to use Excel to populate data into individual cells
> corresponding to three individual (and unrelated) headings, and once
> finished, enter a simple keystroke (ie. execute a macro) that would
> produce an output of every possible combination the data in the cells
> inputted under each of the headings. The icing on the cake of this
> plan would be if the input interface for this process could be
> presented to the user in the form of a three-dimensional look with
> three axes (although I don't know if Excel 2007 can do it). However,
> the three dimensional look is a luxury designed to enhance user
> friendliness... and in fact a two dimensional, 'good old normal Excel
> look' is just fine.
>
> ANALOGY of problem:
> Imagining a three dimensional object – for instance a cube - would be
> the best way to describe an ideal input interface for this, and to
> really understand the idea here. Were it possible (and perhaps it is
> not) to have Excel present cells by width (on a y-axis, that is), AND
> by length (on an x-axis) AND by height (on a z-axis), with
> corresponding rows (or columns, whatever the case may be) of cells
> running along each axis, the user would have a friendly interface to
> use to populate cells along each axis, until he's inputted all of his
> data. At the conclusion of the inputting, the data in each cell along
> each axis is processed and consequently (after selecting a keystroke,
> that is) outputted with every possible combination displayed in a
> single column of cells showing the individual results, separately (one
> result per cell), as the output, on either a separate worksheet or new
> workbook.
>
> SPECIFICS
>
> The input process...
>
> 1) The user begins entering data in the second cell along each axis
> (eg. A2).
> 2) The user can enter any combination of alphanumeric data in a cell,
> and/or leave spaces.
> 3) The user must not skip a cell along any axis (eg. By filling in A7
> and A9, but leaving A8 blank).
> 4) The user may elect not to not input data in the cells running along
> one axis (with the result, for instance, that cells along the x-axis
> and z-axis are populated with data, yet no cells along the y-axis are
> populated).
> 5) The user may input data in more or less cells along one axis than
> along another (eg. user inputs data in three cells along the x-axis, 2
> cells along the y-axis and 4 cells along the z-axis).
>
> The output...
>
> 1) The data inputted into each cell is presented, in output, in every
> possible combination with the data from the other cells.
> 2) A single space is left between each set of data, in the outputted
> format (ie. Tree Car Blue, not TreeCarBlue)
> 3) The integrity of the data in the cell itself is preserved (ie. if
> “Tree” is the input data, it is not then outputted in a shorter form
> such as “Tre” or “T”, in addition to being outputted as "Tree")
> 4) The combinations in the output ought to include using the data in a
> cell under one heading (ie. along one axis, that is), and:
> a) placing it in front of the data in each of the cells under the same
> heading;
> b) placing it behind the data in each of the cells under the same
> heading;
> c) placing it in front of the data in each of the cells under each of
> the other headings;
> d) placing it in behind the data in each of the cells under each of
> the other headings;
> e) placing it between the data from each of the other cells under the
> other headings;
> .... and any other possible combining pattern that one can think of to
> produce the result that every possible combination is shown in the
> output.
> 5) There ought not to be duplicate entries of exactly the same output.
>
>
> EXAMPLE (of inputs, and some of the resulting output):
>
> Inputs:
>
> Along the cells on x-axis:
> X2: Tree
> X3: Flower
>
> Along the cells on y-axis:
> Y2: Car
>
> Along the cells on z-axis:
> Z2: Blue
> Z3: Yellow
>
> Output (in first column of fresh worksheet or workbook):
>
> A1: Tree Flower
> A2: Flower Tree
> A3: Tree Car
> A4: Car Tree
> A5: Tree Blue
> A6: Blue Tree
> A7: Tree Yellow
> A8: Yellow Tree
> A9: Tree Flower Car
> A10: Tree Car Flower
> A11: Tree Blue Car
> A12: Tree Blue Flower Car
> A13: Tree Yellow Flower Car
> A14: Tree Blue Yellow Car Flower
> A15: Car Yellow Flower Tree Blue
>
> etc… (until all combinations are shown)
>
>
> Many thanks, by the way, to the highly skilled MVPs and other persons
> of great intellect who have made this group a success for so many
> years now. You guys are great and I truly aspire to such greatness.
> It's no easy feat!
>
Similar Threads
