bestkeeper
Messages postés90Date d'inscriptionjeudi 19 avril 2007StatutMembreDernière intervention16 juillet 2020
-
5 juin 2009 à 13:11
Bonjour,
un peu d'aide SVP.
J'ai une macro qui m'effectue "une récap" d'un fichier de commande.
Losrque je lance celle-ci, la récap s'arrête à la ligne 532 de ma feuille de commande, les lignes suivantes ne sont pas prises en compte.
Quelqu'un a t il une solution.
Ci après le détail de la macro
Option Explicit
Private myTab()
Private ind As Long
Public Sub mainTri()
prepareTri
lanceRecap
End Sub
Private Sub prepareTri()
Dim ws As Worksheet
Dim i As Long
Set ws = Worksheets("commandes")
i = 2
While ws.Range("A" & i).Value <> ""
If doesExist(ws.Range("A" & i).Value) = False Then
ind = ind + 1
ReDim Preserve myTab(ind)
myTab(ind) = ws.Range("A" & i).Value
End If
i = i + 1
Wend
Set ws = Nothing
End Sub
Private Sub lanceRecap()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim lig1 As Long
Dim lig2 As Long
Dim i As Long
Dim str As Variant
Set ws1 = Worksheets("commandes")
Set ws2 = Worksheets("recap")
lig2 = 2
Call TriTab(True) 'True tri croissant, False tri décroissant
For i = 1 To ind
lig1 = 2
str = myTab(i)
While ws1.Range("A" & lig1).Value <> ""
If ws1.Range("A" & lig1).Value = str Then
ws1.Select
ws1.Range("B" & lig1).Copy
ws2.Select
ws2.Range("A" & lig2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws1.Select
ws1.Range("A" & lig1).Copy
ws2.Select
ws2.Range("B" & lig2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws1.Select
ws1.Range("E" & lig1).Copy
ws2.Select
ws2.Range("D" & lig2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
ws1.Range("C" & lig1).Copy
ws2.Select
ws2.Range("C" & lig2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
lig2 = lig2 + 1
End If
lig1 = lig1 + 1
Wend
Next i
Set ws1 = Nothing
Set ws2 = Nothing
End Sub
Private Function doesExist(ByVal str As Variant) As Boolean
Dim i As Long
For i = 1 To ind
If myTab(i) = str Then
doesExist = True
Exit Function
End If
Next i
doesExist = False
End Function
Sub TriTab(bASC As Boolean)
Dim i As Long, j As Long
Dim Temp As String
If bASC Then ' croissant
For i = LBound(myTab()) To UBound(myTab()) - 1
For j = i + 1 To UBound(myTab())
If myTab(i) > myTab(j) Then
Temp = myTab(j)
myTab(j) = myTab(i)
myTab(i) = Temp
End If
Next j
Next i
Else ' décroissant
For i = LBound(myTab()) To UBound(myTab()) - 1
For j = i + 1 To UBound(myTab())
If myTab(i) < myTab(j) Then
Temp = myTab(j)
myTab(j) = myTab(i)
myTab(i) = Temp
End If
Next j
Next i
End If
End Sub