T
taranto57
From various researches on the Internet I found this macro in VBA that
allows combinations of elements (numbers or letters) written from A2 to B18
Sheet2 and print combinations.
Example: in sheet1 insert values ​​in
A2 = 1 - 2 = B2 - C2 = 3
A3 = 4 - B3 = 5
A4 = 6
which are combined by the macro from A2 to C7
1-2-3
1-5-3
4-2-3
4-5-3
6-2-3
6-5-3
I would bring changes to the list in such a way that the combinations were
developed (type pools coupon) in vertical mode.
Let me explain with an example: in sheet1 I have values ​​equal to
A2 = 1 - B2=2 - C2 = 3 (first line 3 variants)
A3 = 4 - B3 = 5 (second row 2 variants)
A4 = 6 (third row 1 variant)
that give 6 columns (3 * 2 * 1 = 6)
with this representation
1-2-3-1-2-3
4-5-4-5-4-5
6-6-6-6-6-6
Thanks in advance
Michele
Sub Combinazioni5()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim C1 As Range, C2 As Range, C3 As Range
Dim C1R As Range, C2R As Range, C3R As Range
Dim NRiga As Long
Dim Colonna As Long
Set ws1 = ThisWorkbook.Sheets("Foglio1")
Set ws2 = ThisWorkbook.Sheets("Foglio2")
'Worksheets(1).Select
With ws1
Set C1 = .Range("A2:A18")
Set C2 = .Range("B2:B18")
Set C3 = .Range("C2:C18")
End With
Colonna = 1
'Worksheets(2).Select
ws2.Range("a2:e" & Rows.Count) = ""
'Application.EnableEvents = False
For Each C1R In C1
If C1R <> "" Then
For Each C2R In C2
If C2R <> "" Then
For Each C3R In C3
If C3R <> "" Then
With ws2
NRiga = .Cells(Rows.Count, Colonna).End(xlUp).Row
..Cells(NRiga + 1, Colonna) = C1R
..Cells(NRiga + 1, Colonna + 1) = C2R
..Cells(NRiga + 1, Colonna + 2) = C3R
End With
If NRiga >= 500000 Then Colonna = Colonna + 6
End If
Next
End If
Next
End If
Next
'Application.EnableEvents = True
'Worksheets(1).Select
Set ws1 = Nothing
Set ws2 = Nothing
Set C1 = Nothing
Set C2 = Nothing
Set C3 = Nothing
End Sub
allows combinations of elements (numbers or letters) written from A2 to B18
Sheet2 and print combinations.
Example: in sheet1 insert values ​​in
A2 = 1 - 2 = B2 - C2 = 3
A3 = 4 - B3 = 5
A4 = 6
which are combined by the macro from A2 to C7
1-2-3
1-5-3
4-2-3
4-5-3
6-2-3
6-5-3
I would bring changes to the list in such a way that the combinations were
developed (type pools coupon) in vertical mode.
Let me explain with an example: in sheet1 I have values ​​equal to
A2 = 1 - B2=2 - C2 = 3 (first line 3 variants)
A3 = 4 - B3 = 5 (second row 2 variants)
A4 = 6 (third row 1 variant)
that give 6 columns (3 * 2 * 1 = 6)
with this representation
1-2-3-1-2-3
4-5-4-5-4-5
6-6-6-6-6-6
Thanks in advance
Michele
Sub Combinazioni5()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim C1 As Range, C2 As Range, C3 As Range
Dim C1R As Range, C2R As Range, C3R As Range
Dim NRiga As Long
Dim Colonna As Long
Set ws1 = ThisWorkbook.Sheets("Foglio1")
Set ws2 = ThisWorkbook.Sheets("Foglio2")
'Worksheets(1).Select
With ws1
Set C1 = .Range("A2:A18")
Set C2 = .Range("B2:B18")
Set C3 = .Range("C2:C18")
End With
Colonna = 1
'Worksheets(2).Select
ws2.Range("a2:e" & Rows.Count) = ""
'Application.EnableEvents = False
For Each C1R In C1
If C1R <> "" Then
For Each C2R In C2
If C2R <> "" Then
For Each C3R In C3
If C3R <> "" Then
With ws2
NRiga = .Cells(Rows.Count, Colonna).End(xlUp).Row
..Cells(NRiga + 1, Colonna) = C1R
..Cells(NRiga + 1, Colonna + 1) = C2R
..Cells(NRiga + 1, Colonna + 2) = C3R
End With
If NRiga >= 500000 Then Colonna = Colonna + 6
End If
Next
End If
Next
End If
Next
'Application.EnableEvents = True
'Worksheets(1).Select
Set ws1 = Nothing
Set ws2 = Nothing
Set C1 = Nothing
Set C2 = Nothing
Set C3 = Nothing
End Sub