Modifier une macro
j
Bonjour le forum
J'ai une macro qui me fabique des combinaisons et affiche le nombre de sortie de ces combinaisons, je voudrais la modifier pour qu'elle ne fabrique plus les combinaisons mais effectue juste le test de sortie car je voudrais mettre mes propres combinaisons en B3
c'est àdire ne plus se servir de la ligne 1 ni de la cellule B2.
Mais comment modifier cette macro etant nul en vba.
Sub Go()
'
' Go Macro
Dim Ta&(), Tc&(), Tb&(), w As Worksheet, NbA&, NbB&, NbC#, i&, j&, k&, h&, Lg&, Co&, M As Byte, R As Byte
Set w = Worksheets("Combi")
w.Range(w.Cells(3, 1), w.Cells(Rows.Count, 22)).ClearContents
NbA = w.Cells(1, Columns.Count).End(xlToLeft).Column - 1
On Error Resume Next
NbB = w.Cells(2, 2)
On Error GoTo 0
If NbB = 0 Then MsgBox "Inscrire le nombre de n° par combinaisons en B2": Exit Sub
If NbB > 10 Then MsgBox "Nombre de n° par combinaisons en B2 <= 10": Exit Sub
If NbB > NbA Then MsgBox "Pas assez de n° trouvés en ligne A": Exit Sub
On Error Resume Next
NbC = CmbNb(NbA, NbB)
On Error GoTo 0
If NbC = 0 Or NbC > Rows.Count Then MsgBox "Trops de combinaisons": Exit Sub
ReDim Ta(1 To NbA)
For i = 1 To NbA
On Error Resume Next
Ta(i) = w.Cells(1, i + 1)
On Error GoTo 0
If Ta(i) = 0 Then MsgBox "Anomalie en cellule ligne 1, colonne " & (i + 1): Exit Sub
For j = 1 To i - 1
If Not Ta(i) > Ta(j) Then MsgBox "Anomalie : doublon ou mauvais rangement en ligne 1": Exit Sub
Next j, i
Tc = CmbTab(NbA, NbB)
For i = 1 To NbC
For j = 1 To NbB
Tc(i, j) = Ta(Tc(i, j))
Next j
Next i
Erase Ta
w.Range(w.Cells(3, 2), w.Cells(2 + NbC, 1 + NbB)) = Tc
Lg = w.Cells(Rows.Count, 23).End(xlUp).Row - 2
Co = w.Cells(3, Columns.Count).End(xlToLeft).Column - 22
ReDim Ta(1 To Lg, 1 To Co)
For i = 1 To Lg
For j = 1 To Co
Ta(i, j) = w.Cells(i + 2, j + 22)
For k = 1 To j - 1
If Not Ta(i, j) > Ta(i, k) Then MsgBox "Anomalie : doublon ou mauvais rangement en ligne " & (i + 2): Exit Sub
Next k
Next j, i
ReDim Tb(1 To NbC, NbB)
For i = 1 To NbC
For j = 1 To Lg
M = 0
R = 1
For k = 1 To NbB
For h = R To Co
If Tc(i, k) = Ta(j, h) Then M = M + 1: R = h + 1: Exit For
Next h
Next k
Tb(i, M) = Tb(i, M) + 1
Next j
Next i
Erase Tc
w.Range(w.Cells(3, 12), w.Cells(2 + NbC, 11 + NbB + 1)) = Tb
End Sub
Sub RaZ()
Dim w As Worksheet
Set w = Worksheets("Combi")
w.Range(w.Cells(3, 1), w.Cells(Rows.Count, 22)).ClearContents
End Sub
'----------------------------------------------------------------------------------------------------------------
'Nombre de combinaisons de b éléments pris parmis a éléments*****************************************************
'Input : a, b****************************************************************************************************
'----------------------------------------------------------------------------------------------------------------
Function CmbNb(ByVal a&, ByVal b&) As Variant
Dim c&
On Error GoTo ErrTrp
If Not a < 0 And Not b < 0 And Not b > a Then
c = a - b
If c = 0 Then
CmbNb = 1
Else
If b < c Then c = b
CmbNb = FactLim(a, c) / FactLim(c)
End If
Else
CmbNb = CVErr(xlErrNum)
End If
Exit Function
ErrTrp:
On Error GoTo 0
CmbNb = CVErr(xlErrNum)
End Function
'----------------------------------------------------------------------------------------------------------------
'Factorielle de Lg***********************************************************************************************
'Option : limiter le nombre d'itérations*************************************************************************
'----------------------------------------------------------------------------------------------------------------
Function FactLim(ByVal Lg&, Optional NbIter) As Variant
Dim i&, n&
On Error GoTo ErrTrp
If Not Lg < 0 Then
If Not IsMissing(NbIter) Then n = CLng(NbIter) Else n = Lg
If n > Lg Or n < 0 Then
GoTo ErrTrp
Else
FactLim = 1
If Lg > 0 Then
For i = 0 To n - 1: FactLim = FactLim * (Lg - i): Next i
End If
End If
Else
FactLim = CVErr(xlErrNA)
End If
Exit Function
ErrTrp:
On Error GoTo 0
FactLim = CVErr(xlErrNum)
End Function
'----------------------------------------------------------------------------------------------------------------
'combinaisons b parmi a******************************************************************************************
'Input : longs***************************************************************************************************
'Output : tableau long*******************************************************************************************
'Rem : taille max varie selon systèmes, si erreur ubound(t)=0****************************************************
'----------------------------------------------------------------------------------------------------------------
Function CmbTab(ByVal a&, ByVal b&) As Long()
Dim n&, t&(), c&, i&, j&, v As Variant
If Not a < 1 And Not b < 1 And Not b > a Then
On Error GoTo ErrTrp
n = CLng(CmbNb(a, b))
ReDim t(1 To n, 1 To b)
c = a - b
For i = 1 To b
t(1, i) = i
Next i
For i = 2 To n
If b = 1 Then t(i, 1) = t(i - 1, 1) - (b = 1) Else t(i, 1) = t(i - 1, 1) + (t(i - 1, 2) = c + 2) * (b <> 1)
For j = 2 To b - 1
If t(i - 1, j + 1) = c + j + 1 Then
If t(i - 1, j) = c + j Then t(i, j) = t(i, j - 1) + 1 Else t(i, j) = t(i - 1, j) + 1
Else
t(i, j) = t(i - 1, j)
End If
Next j
If t(i - 1, b) = a Then t(i, b) = t(i, b - 1) + 1 Else t(i, b) = t(i - 1, b) + 1
Next i
CmbTab = t
Else
ErrTrp:
On Error GoTo 0
ReDim t(0)
CmbTab = t
End If
End Functionmerci