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
|
Sub test()
Dim i As Integer, j As Integer, k As Integer
Dim cle As String, CurrString As String
Dim FL1 As Worksheet 'Feuille "Sheet3"
Dim FL2 As Worksheet 'Feuille "Sheet1"
Dim c As Range, LigDeb As String
Dim Dtype as string
Application.ScreenUpdating = False
'Instanciation des feuilles de calculs concernées (pour simplifier le code à venir)
Set FL1 = Worksheets("Sheet3")
Set FL2 = Worksheets("Sheet1")
CurrString = ""
j = 4
Application.ScreenUpdating = False
While FL1.Cells(1, j).Value <> ""
For i = 2 To 360
'La clé est constituée de la colonne 3 d'une même ligne & de la colonne J de la ligne 1
cle = FL1.Cells(i, 3).Value & FL1.Cells(1, j).Value
'Recherche de la valeur de FL1.Cells(i,3) dans la colonne F de FL2
With FL2.Range("Y2:Y" & Split(FL2.UsedRange.Address, "$")(4))
Set c = .Find(FL1.Cells(i, 3).Value)
If Not c Is Nothing Then
LigDeb = c.Address
Do
k = c.Row
CurrString = FL2.Cells(k, 5).Value & FL2.Cells(k, 6).Value & FL2.Cells(k, 7).Value & FL2.Cells(k, 8).Value & FL2.Cells(k, 9).Value & FL2.Cells(k, 10).Value & FL2.Cells(k, 11).Value & FL2.Cells(k, 12).Value & FL2.Cells(k, 13).Value & FL2.Cells(k, 14).Value & FL2.Cells(k, 15).Value & FL2.Cells(k, 16).Value & FL2.Cells(k, 17).Value
If CurrString = cle Then
FL1.Cells(i, j) = FL2.Cells(k, 18)
'récupère le type qui est en colonne c'
dtype = FL2.Cells(k,3)
with FL1.Cells(i,j).Font
select case dtype
case "1"
.Bold = True
.ColorIndex = xlAutomatic
case "2"
.Bold = False
.Colorindex = 3
case "3"
.Bold = False
.Colorindex = 5
case else
.Bold = False
.colorindex = xlautomatic
end select
end with
end if
'Cette recherche ne se poursuit que si FL1.Cells(i, 1) a été trouvé
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> LigDeb
End If
End With
Next i
'Ajoute une ligne à FL1
j = j + 1
Wend
Application.ScreenUpdating = True
End Sub |
Partager