Variation zone de sélection

Bonjour tout le monde,

J'ai un léger problème d'optimisation de procédure.

Serait-il possible de sélectionner une zone de sélection en fonction de conditions afin de traiter la zone sélectionnée par la suite.:?

La logique est la suivante :

Si la combobox "Combobox1" a la valeur "Enterrés", je peux sélectionner que de la cellule k8 à k9 de la feuille3.

Si la combobox "Combobox1" a la valeur "Non enterrés", j'ai 2 cas de figures possible :

1 : Sélection de la cellule k1 à la cellule k5

2 : Sélection de la cellule k1 à la cellule k4

La procédure que j'ai essayé de faire est la suivante (précison : elle ne fonctionne pas):

Code:

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
62
Private Sub Instal_Click()
    Dim Celld As Range
    Dim Tableaud()
    Dim TempTabd As Variant
    Dim id As Integer, jd As Integer
    Dim boolVerifd As Boolean
    Dim d As Range
 
    ReDim Tableaud(1 To 1)
    Tableaud(1) = Cells(1, 1)
 
    'Boucle sur les données dans la Feuil3
    If ComboBox1.Value = "Enterrés" Then
        d = Worksheets("Feuil3").Range("K8,K9")
    ElseIf ComboBox1.Value = "Non enterrés" Then
        If pose.Value = "Sous conduit, profilé ou goulotte, en apparent ou encastré  " Or "Sous vide de construction, faux plafond" Or "Sous caniveau, moulures, plinthes, chambranles" Then
 
            d = Worksheets("Feuil3").Range("K1,K5")
 
        ElseIf pose.Value = "En apparent contre mur ou plafond " Or "Sur chemin de câbles ou tablettes non perforées" Then
 
            d = Worksheets("Feuil3").Range("K1,K6")
 
        End If
    End If
 
    For Each Celld In d
 
        boolVerifd = False
 
        'Vérifie si le contenu de la cellule existe déjà dans le tableau
        For id = 1 To UBound(Tableaud)
            'Si la donnée existe déjà dans le tableau
            If Tableaud(id) = Celld Then
                boolVerifd = True
                Exit For
            End If
        Next
 
       'Si la donnée n'existe pas dans le tableau, on augmente la taille du tableau
        'et on ajoute la donnée.
        If boolVerifd = False Then
            ReDim Preserve Tableaud(1 To UBound(Tableaud) + 1)
            Tableaud(UBound(Tableaud)) = Celld
        End If
 
        'Tri le contenu du tableau par ordre croissant.
        For id = 1 To UBound(Tableaud)
            For jd = 1 To UBound(Tableaud)
                If Tableaud(id) < Tableaud(jd) Then
                    TempTabd = Tableaud(id)
                    Tableaud(id) = Tableaud(jd)
                    Tableaud(jd) = TempTabd
                End If
            Next jd
        Next id
    Next Celld
 
    'Alimente le ComboBox
    Instal.List = Tableaud
 
End Sub

Si quelqu'un peut m'aider, je suis preneur.

PS : merci Skyroad pour la FAQ, elle m'a sauvé la mise:king:

Bonsoir,

Essaye comme ceci :
Au lieu de d = ... --> Set d = ...
Le changer partout

Si ça coince encore, précise au moins la ligne de ton code qui bug parce que sans indication précise, sans fichier, il faut essayer de deviner :?

PS : ça concerne quel type de câble ?

J'ai remplacé d apr Set d, mais le programme affiche "Objet requis" au niveau de :

For Each Celld In d

Si tu as bien ajouté Set à toutes les lignes d = ..., si tu as bien une feuille qui se nomme "Feuil3", alors je ne vois pas pourquoi ça coince.
Tu peux faire le petit test ci-dessous
Code:

1 2 3 4 5 6 7 Sub test() Dim d As Range, Celd As Range Set d = Sheets(3).Range("A1:B10") For Each Celd In d Celd.Interior.ColorIndex = 6 Next End Sub
Tu pourras constater que là ça fonctionne mais par contre si on écrit d = Sheets(3).Range("A1:B10") ça bug