Discussion :

[apt]

Bonsoir à tous,

J'aimerais, depuis une liste déroulante et selon la valeur choisie, sélectionner deux tableaux à la fois qui se trouvent cote à cote et commencent depuis la même ligne.

Par exemple si je choisi la valeur 3 dans la liste déroulante, on va chercher cette valeur dans la plage "N8:N100", et s'il y a succès de la recherche, je devrais sélectionner le premier tableau (Colonne A à K) plus le deuxième tableau (Colonne M et N).

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Range("A" & y - 1 & ":N" & y + nbl)

Mais j'ai un petit souci : Lorsque la valeur se trouve dans la colonne en plusieurs fois, la recherche est faussée induisant en faute la sélection désirée.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim x&, y&, nbl&, nblA&, nblM&, LastLg&, i&
    Dim PrntRng As Range
    Application.ScreenUpdating = False
    If Target.Address = "$B$1" And Target.Count = 1 Then
 
        x = Val(Target.Value)
        y = -1
        On Error Resume Next
        '--
        LastLg = [N65000].End(xlUp).Row
        i = 1
        Do Until i < LastLg
            '--
            y = Application.Match(x, Range("N" & i & ":N" & LastLg))
            If Range("M" & y).Value = "Récapitulatif N°" Then
                i = LastLg
            Else
                i = y + 1
            End If
            '---
        Loop
        '---
 
        If y < 1 Then
            MsgBox "Numéro (" & x & ") est introuvable"
        Else
            CommandButton1.Caption = "Imprimer " & vbCrLf & "Le tableau " & Range("B1")
            nblA = Range("A" & y - 1).CurrentRegion.Rows.Count - 2
            nblM = Range("M" & y - 1).CurrentRegion.Rows.Count - 2
 
            nbl = IIf(nblA > nblM, nblA, nblM)
            Set PrntRng = Range("A" & y - 1 & ":N" & y + nbl)
            PrntRng.Name = "Print_Area"
            Range("Print_Area").Select
        End If
    End If
    Application.ScreenUpdating = True
End Sub

[apt]

Bonsoir,

Peut-être un exemple qui peut bien éclaircir les choses.

[mercatog]

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Lig As Long, NblA As Long, NblM As Long, Nbl As Long
Dim Prem As String
Dim c As Range
 
Application.ScreenUpdating = False
If Target.Address = "$B$1" Then
    If Target.Value <> "" Then
        Set c = Range("N:N").Find(Target.Value, LookIn:=xlValues, lookat:=xlWhole)
        If Not c Is Nothing Then
            Do
                Prem = c.Address
                If InStr(c.Offset(0, -1), "Récapitulatif N°") > 0 Then
                    Lig = c.Row - 1
                    Set c = Nothing
                    Exit Do
                End If
                Set c = Range("N:N").FindNext(c)
            Loop While Not c Is Nothing And c.Address <> Prem
        End If
        If Lig = 0 Then
            MsgBox "N° " & Target.Value & " introuvable"
        Else
            CommandButton1.Caption = "Imprimer " & vbCrLf & "Le tableau " & Target.Value & " Ligne " & Lig
            NblA = Range("A" & Lig).CurrentRegion.Rows.Count
            NblM = Range("M" & Lig).CurrentRegion.Rows.Count
            Nbl = Application.Max(NblA, NblM)
            Range("A" & Lig & ":N" & Lig + Nbl - 1).Select
        End If
    End If
End If
End Sub

[apt]

Bonjour mercatog,

Ca marche très bien.

Merci.