1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60
| Option Explicit
Dim Tablo() As Variant
Dim TabloCombi() As String
Sub Combinaisons()
Dim CptLig As Integer
Dim CptCol As Byte
Dim Combinaison As String
ReDim Tablo(1 To Feuil1.UsedRange.Rows.Count, 1 To Feuil1.UsedRange.Columns.Count)
ReDim TabloCombi(1 To 1)
For CptLig = 1 To Feuil1.UsedRange.Rows.Count
For CptCol = 1 To Feuil1.UsedRange.Columns.Count
If Feuil1.Cells(CptLig, CptCol).Value <> "" Then
Tablo(CptLig, CptCol) = Feuil1.Cells(CptLig, CptCol).Value
End If
Next CptCol
Next CptLig
ChercheCombinaison 1, 1, ""
For CptLig = 2 To UBound(TabloCombi)
Feuil2.Range("A" & CptLig).Value = TabloCombi(CptLig)
Next CptLig
ReDim Tablo(0)
ReDim TabloCombi(0)
End Sub
Sub ChercheCombinaison(CptLigIni As Integer, CptColIni As Byte, PrefCombinaison As String)
Dim CptLig As Integer
Dim CptCol As Byte
Dim CombiTmp As String
CombiTmp = PrefCombinaison
For CptLig = 1 To UBound(Tablo, 1)
For CptCol = CptColIni To UBound(Tablo, 2)
If Not IsEmpty(Tablo(CptLig, CptCol)) Then
CombiTmp = CombiTmp & " " & Tablo(CptLig, CptCol)
If CptCol = UBound(Tablo, 2) Then
ReDim Preserve TabloCombi(1 To UBound(TabloCombi) + 1)
TabloCombi(UBound(TabloCombi)) = Mid(CombiTmp, 2)
CombiTmp = PrefCombinaison
Exit For
ElseIf CptCol < UBound(Tablo, 2) Then
ChercheCombinaison CptLig, CptCol + 1, CombiTmp
CombiTmp = PrefCombinaison
Exit For
End If
Else
CombiTmp = PrefCombinaison
Exit For
End If
Next CptCol
Next CptLig
End Sub |
Partager