Discussion :

[roidurif]

Bonjour,

Dans mon tableau, j’ai une colonne département contenant plusieurs dpts (ex. 75,77,78,91,92,93,94,95,18,36,37,41,45,86,89,28). J’aimerais à partir de la table de correspondance DPT/ZONE (2ème onglet) identifié quand un département est présent dans le 1er tableau, mettre une croix en face de la ZONE.

J’ai joint un exemple dans mon fichier avec un début de macro.

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
40
41
 
Sub Dept()
 
Dim ShSource As Worksheet
Dim ShCible As Worksheet
Dim Shdept As Worksheet
 
Dim Rg As Range
 
Dim i As Long
Dim iCible As Long
Dim Idept As Long
Dim Itableau As Integer
Dim strdept() As String
 
Set ShSource = ThisWorkbook.Worksheets("Feuil1")
Set Shdept = ThisWorkbook.Worksheets("Table DPT")
 
 
For i = 2 To ShSource.Range("A" & Rows.Count).End(xlUp).Row
    'Insere les département dans la variable tableau
    strdept = Split(ShSource.Range("D" & i).Value, " ")
    'Traite chaque département
    For Itableau = 0 To UBound(strdept)
        'recherche le département
        Set Rg = Shdept.Range("A:A").Find(what:=strdept(Itableau), lookat:=xlWhole)
        'Traitement si trouvé
        If Not Rg Is Nothing Then
 
'....
 
 
                Idept = Idept + 1
            Loop
 
        End If
    Next Itableau
 
Next i
 
End Sub

Merci

[mercatog]

Proposition utilisant les variables tableaux

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
40
41
42
Sub Traiter()
Dim Dep, Res
Dim i As Integer, j As Integer, m As Integer, n As Integer
 
 
Dep = Worksheets("Table DPT").Range("A1").CurrentRegion
m = UBound(Dep, 1)
If m > 1 Then
    Res = Worksheets("Feuil1").Range("A1").CurrentRegion
    n = UBound(Res, 1)
    If n > 1 Then
        Effacer Res
        For i = 2 To m
            For j = 2 To n
                If InStr(Res(j, 4), Dep(i, 1)) > 0 Then Croix Res, j, Dep(i, 3)
            Next j
        Next i
    End If
End If
Worksheets("Feuil1").Range("A1").CurrentRegion = Res
End Sub
 
Private Sub Croix(ByRef Tb, ByVal k As Integer, ByVal Str As String)
Dim i As Integer
 
For i = 5 To UBound(Tb, 2)
    If Tb(1, i) = Str Then
        Tb(k, i) = "X"
        Exit For
    End If
Next i
End Sub
 
Private Sub Effacer(ByRef Tb)
Dim i As Integer, j As Integer
 
For i = 2 To UBound(Tb, 1)
    For j = 5 To UBound(Tb, 2)
        Tb(i, j) = Empty
    Next j
Next i
End Sub

[roidurif]

Merci mercatog pour ton aide,cela fonctionne. J’essaie de pousser la macro en essayant de faire des tests dans le cas où il y a du texte (ex: Destiné pour les DPTS : 75,77,78,91,92,93,94,95,18,36,37,41,45,86,89,28. Pour plus de 95 kg, voir refs. 757741)

Comment pourrais je lire que les dpts?

merci