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
| Option Explicit
Option Base 1
Private Sub Worksheet_Change(ByVal Target As Range)
Dim C, D, E As Range
Dim i, j As Integer
Dim strAddress As String
Dim strPiece, strPrix As Variant
Dim strPieces(17), strPrixs() As String
If Target.Count > 1 Then Exit Sub
If Target.Address <> "$B$4" Then Exit Sub
Application.ScreenUpdating = False
With Sheets("PRODUITS")
Set C = .Rows(3).Find(Target.Value, , , xlWhole)
Set D = .Columns(C.Column).Find("X", , , xlWhole)
If D Is Nothing Then Exit Sub
strAddress = D.Address
Do
strPieces(D.Row - 3) = .Cells(D.Row, 2)
Set D = .Columns(C.Column).FindNext(D)
Loop While D.Address <> strAddress
End With
i = 4
With Sheets("SELECTION")
'Effacement des cellules
.Range("D4:O20").ClearContents
For Each strPiece In strPieces
If strPiece <> "" Then
'Affichage des pièces
.Cells(i, 4) = (strPiece)
i = i + 1
'Affichage des prix
ReDim strPrixs(100)
With Sheets("PRIX")
Set C = .Columns(2).Find(strPiece, , , xlWhole)
If C Is Nothing Then Exit Sub
strAddress = C.Address
Do
strPrixs(C.Row - 3) = .Cells(C.Row, 3)
Set C = .Columns(2).FindNext(C)
Loop While C.Address <> strAddress
End With
j = 6
For Each strPrix In strPrixs
If strPrix <> "" Then
.Cells(i - 1, j) = strPrix
j = j + 1
End If
Next
End If
Next strPiece
End With
End Sub |
Partager