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 |
Partager