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
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
| Sub SoloTablo()
Dim N1 As Long, N2 As Long, N As Long, i As Long
Dim S1 As Worksheet, S2 As Worksheet
Dim Tb As Variant, Tmp As Variant
Dim T As Single
T = Timer
Application.ScreenUpdating = False
Set S1 = Worksheets("Feuil1")
N1 = S1.Cells(S1.Rows.Count, 1).End(xlUp).Row
Set S2 = Worksheets("Feuil2")
N2 = S2.Cells(S2.Rows.Count, 1).End(xlUp).Row
N = N1 + N2 - 2
Tb = S1.Range("A2:D" & N + 2).Value
For i = 1 To N1 - 1
Tb(i, 3) = 1
Tb(i, 4) = i
Next i
Tmp = S2.Range("A2:B" & N2 + 1).Value
For i = N1 To N + 1
Tb(i, 1) = Tmp(i - N1 + 1, 1)
Tb(i, 3) = 2
Tb(i, 4) = i
Next i
Tri Tb, 1, N, 1
Remplissage Tb
Tri Tb, 1, N, 4
S1.Range("A2:B" & N1).Value = Tb
Set S1 = Nothing
For i = N1 To N + 1
Tmp(i - N1 + 1, 2) = Tb(i, 2)
Next i
S2.Range("A2:B" & N2) = Tmp
Set S2 = Nothing
MsgBox Timer - T
End Sub
Private Sub Tri(ByRef A As Variant, ByVal Gauche As Long, ByVal Droite As Long, ByVal ColTri As Byte)
Dim Tmp As Variant, Ref As Variant
Dim G As Long, D As Long
Dim i As Byte
Ref = A((Gauche + Droite) \ 2, ColTri)
G = Gauche
D = Droite
Do
Do While A(G, ColTri) < Ref
G = G + 1
Loop
Do While A(D, ColTri) > Ref
D = D - 1
Loop
If G <= D Then
For i = LBound(A, 2) To UBound(A, 2)
Tmp = A(G, i)
A(G, i) = A(D, i)
A(D, i) = Tmp
Next i
G = G + 1
D = D - 1
End If
Loop While G <= D
If G < Droite Then Tri A, G, Droite, ColTri
If D > Gauche Then Tri A, Gauche, D, ColTri
End Sub
Private Sub Remplissage(ByRef B As Variant)
Dim i As Long, j As Long, k As Long, P As Long
Dim Existe As Boolean
P = UBound(B, 1)
i = 1
Do
j = i
Do While B(i, 1) = B(i + 1, 1)
If Not Existe Then
If B(i, 3) <> B(i + 1, 3) Then Existe = True
End If
i = i + 1
Loop
If Existe Then
Existe = False
For k = j To i
B(k, 2) = "OK"
Next k
Else
For k = j To i
B(k, 2) = "ko"
Next k
End If
i = i + 1
Loop Until i = P
End Sub |
re
Répondre avec citation
Envoyé par mercatog
,tes codes manques de rigueur, et ne sont pas vérifiés, (ça m'arrive aussi !).
Partager