[COLOR="Navy"]Sub[/COLOR] MG10Dec53
[COLOR="Navy"]Dim[/COLOR] Rng [COLOR="Navy"]As[/COLOR] Range, Dn [COLOR="Navy"]As[/COLOR] Range, n [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Txt [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String,[/COLOR] RngAc [COLOR="Navy"]As[/COLOR] Range, Ac [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] R [COLOR="Navy"]As[/COLOR] Range
[COLOR="Navy"]Dim[/COLOR] c [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Long,[/COLOR] Ray() [COLOR="Navy"]As[/COLOR] Variant, Dic [COLOR="Navy"]As[/COLOR] Object
[COLOR="Navy"]With[/COLOR] Sheets("Rabat")
[COLOR="Navy"]Set[/COLOR] Rng = .Range("A4", .Range("A" & Rows.Count).End(xlUp))
[COLOR="Navy"]Set[/COLOR] RngAc = .Range("L3", .Cells(3, Columns.Count).End(xlToLeft)).SpecialCells(xlCellTypeConstants)
[COLOR="Navy"]End[/COLOR] With
MsgBox RngAc.Address
ReDim Ray(1 To RngAc.Count, 1 To 2)
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] R [COLOR="Navy"]In[/COLOR] RngAc
[COLOR="Navy"]If[/COLOR] IsDate(R.Value) [COLOR="Navy"]Then[/COLOR]
c = c + 1
[COLOR="Navy"]Set[/COLOR] Ray(c, 1) = R
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] R
Application.ScreenUpdating = False
[COLOR="Navy"]Set[/COLOR] Dic = CreateObject("scripting.dictionary")
Dic.CompareMode = vbTextCompare
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
Txt = Trim(Dn.Value) & Trim(Dn.Offset(, 2).Value)
[COLOR="Navy"]Set[/COLOR] Dic(Txt) = Dn
[COLOR="Navy"]Next[/COLOR]
[COLOR="Navy"]With[/COLOR] Sheets("Database")
[COLOR="Navy"]Set[/COLOR] Rng = .Range("B6", .Range("B" & Rows.Count).End(xlUp))
[COLOR="Navy"]End[/COLOR] With
Txt = ""
[COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] Dn [COLOR="Navy"]In[/COLOR] Rng
[COLOR="Navy"]For[/COLOR] n = 0 To 1
Txt = IIf(n = 0, Trim(Dn.Value) & Trim(Dn.Offset(, 10).Value), Trim(Dn.Value))
[COLOR="Navy"]With[/COLOR] Sheets("Rabat")
[COLOR="Navy"]If[/COLOR] Dic.exists(Txt) [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]For[/COLOR] Ac = 1 To UBound(Ray)
[COLOR="Navy"]If[/COLOR] Ray(Ac, 1) = Ray(1, 1) [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]If[/COLOR] Dn.Offset(, 13).Value <= CDate(Ray(Ac, 1)) [COLOR="Navy"]Then[/COLOR]
Dn.Offset(, 19).Value = Format(.Cells(Dic(Txt).Row, Ray(Ac, 1).Column), "0.00%")
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]ElseIf[/COLOR] CDate(Ray(Ac, 1)) = CDate(Ray(UBound(Ray, 1), 1)) [COLOR="Navy"]Then[/COLOR]
[COLOR="Navy"]If[/COLOR] Dn.Offset(, 13).Value > CDate(Ray(Ac, 1)) [COLOR="Navy"]Then[/COLOR]
Dn.Offset(, 19).Value = Format(.Cells(Dic(Txt).Row, Ray(Ac, 1).Column), "0.00%")
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Else[/COLOR]
[COLOR="Navy"]If[/COLOR] Dn.Offset(, 13).Value <= CDate(Ray(Ac, 1)) _
And Dn.Offset(, 13).Value > CDate(Ray(Ac - 1, 1)) [COLOR="Navy"]Then[/COLOR]
Dn.Offset(, 19).Value = Format(.Cells(Dic(Txt).Row, Ray(Ac, 1).Column), "0.00%")
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]Next[/COLOR] Ac
[COLOR="Navy"]Exit[/COLOR] For
[COLOR="Navy"]End[/COLOR] If
[COLOR="Navy"]End[/COLOR] With
[COLOR="Navy"]Next[/COLOR] n
[COLOR="Navy"]Next[/COLOR] Dn
Application.ScreenUpdating = True
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
