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
|
Sub recherchex()
Dim rep_d(), adr, rep, dico, i&, j&, nbl_r&, nbl_a&, temp, adr_b(), k%, rep_nbmot%, adr_nbmot%
nbl_a = Range("C3").End(xlDown).Row
nbl_r = Range("O3").End(xlDown).Row
ReDim adr(nbl_a), adr_b(nbl_a), rep(nbl_r), rep_b(nbl_r)
adr = Range("C3:H" & nbl_a).Value
rep = Range("O3:V" & nbl_r).Value
ReDim adr_b(nbl_a)
ReDim Preserve adr(LBound(adr) To UBound(adr), 1 To 5)
For j = LBound(adr) To UBound(adr)
For k = LBound(rep) To UBound(rep)
adr_b(j) = adr(j, 3)
rep_nbmot = UBound(Split(rep(k, 4))) + 1
adr_nbmot = UBound(Split(adr_b(j))) + 1
If Not IsEmpty(Range("H" & j + 2)) Then 'Or k = UBound(rep) Then '(A : si déjà rempli ou repertoire finit)
adr(j, 5) = Range("H" & j + 2)
Exit For
ElseIf (Not IsEmpty(adr(j - 1, 5))) And adr(j - 1, 2) Like adr(j, 2) And adr(j - 1, 3) Like ("*" & adr(j, 3) & "*") And adr(j - 1, 4) Like adr(j, 4) Then '(B :si adresse j identique j-1)
adr(j, 5) = adr(j - 1, 5)
Exit For
ElseIf adr(j, 2) = rep(k, 1) And rep(k, 2) = "0-0-" And rep(k, 3) = "0-0-" Then '(C : si sans segmentation)
If (rep_nbmot = 1 And adr_nbmot <= 3) Or ((rep_nbmot = 2 Or rep_nbmot = 3) And adr_nbmot <= rep_nbmot + 3) Or (rep_nbmot > 4 And adr_nbmot <= 8) Then
If adr(j, 3) Like ("*" & rep(k, 4) & "*") Then
adr(j, 5) = rep(k, 6)
Exit For
End If
End If
ElseIf adr(j, 2) = rep(k, 1) And Application.IsEven(adr(j, 4)) Then '(D : si voie paire)
If (CLng(Split(rep(k, 2), "-")(0)) = 0 And CLng(Split(rep(k, 2), "-")(1)) > 0 And adr(j, 4) >= CLng(Split(rep(k, 2), "-")(1))) _
Or (CLng(Split(rep(k, 2), "-")(0)) > 0 And adr(j, 4) >= CLng(Split(rep(k, 2), "-")(0)) And CLng(Split(rep(k, 2), "-")(1)) > 0 And adr(j, 4) <= CLng(Split(rep(k, 2), "-")(1))) Then
If (rep_nbmot = 1 And adr_nbmot <= 3) Or ((rep_nbmot = 2 Or rep_nbmot = 3) And adr_nbmot <= rep_nbmot + 3) Or (rep_nbmot > 4 And adr_nbmot <= 8) Then
If adr(j, 3) Like ("*" & rep(k, 4) & "*") Then
adr(j, 5) = rep(k, 6)
Exit For
End If
End If
End If
ElseIf adr(j, 2) = rep(k, 1) And Application.IsOdd(adr(j, 4)) Then '(E : si voie impaire)
If (CLng(Split(rep(k, 3), "-")(0)) = 0 And CLng(Split(rep(k, 3), "-")(1)) > 0 And adr(j, 4) >= CLng(Split(rep(k, 3), "-")(1))) _
Or (CLng(Split(rep(k, 3), "-")(0)) > 0 And adr(j, 4) >= CLng(Split(rep(k, 3), "-")(0)) And CLng(Split(rep(k, 3), "-")(1)) > 0 And adr(j, 4) <= CLng(Split(rep(k, 3), "-")(1))) Then
If (rep_nbmot = 1 And adr_nbmot <= 3) Or ((rep_nbmot = 2 Or rep_nbmot = 3) And adr_nbmot <= rep_nbmot + 3) Or (rep_nbmot > 4 And adr_nbmot <= 8) Then
If adr(j, 3) Like ("*" & rep(k, 4) & "*") Then
adr(j, 5) = rep(k, 6)
Exit For
End If
End If
End If
End If
Next k
Range("H" & j + 2) = adr(j, 5)
Next j
End Sub |
Partager