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
| Option Explicit
Sub Traitement()
Dim LastLig As Long, i As Long, j As Long
Dim Dte As Long, Val4 As String, Val5 As String
Dim Tb, Res()
Application.ScreenUpdating = False
With Worksheets("BD")
LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
Tb = .Range("A2:W" & LastLig)
End With
With Worksheets("Calcul")
Dte = CLng(.Range("B1"))
Val4 = .Range("F1")
Val5 = .Range("J1")
For i = 1 To LastLig - 1
If CLng(Tb(i, 3)) = Dte And Tb(i, 4) = Val4 And Tb(i, 5) = Val5 Then
j = j + 1
Transfer Tb, i, Res, j
End If
Next i
LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
If LastLig > 10 Then .Range("A10:L" & LastLig).ClearContents
If j > 0 Then .Range("A10").Resize(j, 12) = Application.Transpose(Res)
End With
End Sub
Private Sub Transfer(ByVal Sce, ByVal n As Long, ByRef Des, ByVal m As Long)
Dim k As Byte
ReDim Preserve Des(1 To 12, 1 To m)
Des(1, m) = m
For k = 2 To 5
Des(k, m) = Sce(n, k - 1)
If k < 5 Then Des(k + 8, m) = Sce(n, k + 3)
Next k
End Sub |
