Discussion :

[nioko]

Bonjour,

Je n'arrive pas à créer une ligne selon plusieurs critère...
Je vous explique je dispose de 2 feuilles, une "Traitement" et une "Menace"
Sur la feuille "Traitement" se trouvera le résultat final.
Sur la feuille "Menace" se trouve les infos a lire et a placer dans la feuilles traitement.

j'ai deja ce code qui me permet de lire les 3 premieres lettre de la colonne "ressource" de la feuille "Traitement" et de la comparer avec les 3 premieres lettre de la colonne "Typres"(Colonne A) de la feuille "Menaces" afin de copier/coller les informations dans la colonne "TypMenace"(Colonne B) de la feuille "Menaces".

Code :

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

1
2
3
4
5
6
    Dim B As Range
    With Sheets("Traitements")
        For Each B In .Range(.[B2], .Cells(.Rows.Count, 2).End(xlUp))
            B.Offset(, 2) = Application.VLookup(Left(B.Value, 3), [Menaces!A:B], 2, 0)
        Next B
    End With

Mon probleme est que sur la colonne A de la feuille "Menaces" les 3 premieres lettre peuvent se repeté mais avec differente "TypMenace" hors mon programme n'affiche que la 1ere menace dans ma feuille "Traitement"...

J'aimerais qu'une ligne soit créé pour que toutes les "TypMenace" soit ajouté a la feuille "Traitement" et non plus une...

ex :

Si vous avez une solution plus simple n'hesitez pas !

Merci

[Daniel.C]

Bonjour,

Essaie :

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
Sub test1()
    Dim Sh As Worksheet, x As Long
    Set Sh = Sheets("Traitement")
    With Sheets("Traitement")
        Ligne = .Cells(.Rows.Count, 2).End(xlUp).Row
    End With
    With Sheets("Menaces")
        For x = Ligne To 2 Step -1
 
            For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
                var2 = .Cells(i, 1)
                If .Cells(i, 1) = Left(Sh.Cells(x, 2), 3) And Sh.Cells(x, 2).Offset(, 2) = "" Then
                    Sh.Cells(x, 2).Offset(, 2) = .Cells(i, 2)
                ElseIf .Cells(i, 1) = Left(Sh.Cells(x, 2), 3) And Sh.Cells(x, 2).Offset(, 2) <> "" Then
                    Rows(x + 1).Insert
                    Sh.Cells(x + 1, 2).Offset(, 2) = .Cells(i, 2)
                End If
            Next i
        Next x
    End With
End Sub

[nioko]

Sa fonctionne très bien !
Par contre le petit soucis est que lorsque je relance le macro il réécris ce qui étais déjà présent donc sa créé des doublons et des lignes inutile...

Il fraudais que le lancement de cette macro puisse lire les infos déjà inscrite et rajouté celle qui ne le sont pas deja.

[Daniel.C]

Ca va compliquer pas mal la procédure. Est-ce qu'on peut effacer ce qui est déjà écrit ?

[nioko]

Oui

[Daniel.C]

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
Sub test1()
    Dim Sh As Worksheet, x As Long
    Set Sh = Sheets("Traitement")
    With Sheets("Traitement")
        Ligne = .Cells(.Rows.Count, 2).End(xlUp).Row
        .[D2:D1000].ClearContents
    End With
    With Sheets("Menaces")
        For x = Ligne To 2 Step -1
 
            For i = 2 To .Cells(.Rows.Count, 1).End(xlUp).Row
                var2 = .Cells(i, 1)
                If .Cells(i, 1) = Left(Sh.Cells(x, 2), 3) And Sh.Cells(x, 2).Offset(, 2) = "" Then
                    Sh.Cells(x, 2).Offset(, 2) = .Cells(i, 2)
                ElseIf .Cells(i, 1) = Left(Sh.Cells(x, 2), 3) And Sh.Cells(x, 2).Offset(, 2) <> "" Then
                    Rows(x + 1).Insert
                    Sh.Cells(x + 1, 2).Offset(, 2) = .Cells(i, 2)
                End If
            Next i
        Next x
    End With
End Sub