Discussion :

[will Igetit]

Bonjour,
voila mon code emais le second if ne marche pas correctement. je souahite faire la chose suivante:
- si egalite des 4 cellules de deux feuilles on supprime.

-si l'egalite des 3 premiere cellules on color en bleu
- sinon color en vert ...
cela marche sauf pour le bleu je ne me retrouve qu'avec du vert...
Est ce que quelq'un serait comment je peux me depetrer de cela?
Merci d'avance
Will

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 Button1_Click()
 
 
Dim i, j, k, l, dercellnew, dercellrecord As Long
 
 
 
dercellnew = ThisWorkbook.Worksheets("New Entries").Range("A65536").End(xlUp).Row
 
dercellrecord = ThisWorkbook.Worksheets("Plant tracker").Range("A65536").End(xlUp).Row
 
 
For i = dercellnew To 4 Step -1
For j = dercellrecord To 10 Step -1
 
    If ThisWorkbook.Worksheets("New Entries").Cells(i, 2) = ThisWorkbook.Worksheets("Plant tracker").Cells(j, 2) _
        And ThisWorkbook.Worksheets("New Entries").Cells(i, 3) = ThisWorkbook.Worksheets("Plant tracker").Cells(j, 3) _
        And ThisWorkbook.Worksheets("New Entries").Cells(i, 4) = ThisWorkbook.Worksheets("Plant tracker").Cells(j, 4) _
        And ThisWorkbook.Worksheets("New Entries").Cells(i, 5) = ThisWorkbook.Worksheets("Plant tracker").Cells(j, 5) _
        And ThisWorkbook.Worksheets("New Entries").Cells(i, 7) = ThisWorkbook.Worksheets("Plant tracker").Cells(j, 7) Then
       ThisWorkbook.Worksheets("New Entries").Cells(i, 7).EntireRow.Delete
    End If
 
    If ThisWorkbook.Worksheets("New Entries").Cells(i, 2) = ThisWorkbook.Worksheets("Plant tracker").Cells(j, 2) _
        And ThisWorkbook.Worksheets("New Entries").Cells(i, 3) = ThisWorkbook.Worksheets("Plant tracker").Cells(j, 3) _
        And ThisWorkbook.Worksheets("New Entries").Cells(i, 4) = ThisWorkbook.Worksheets("Plant tracker").Cells(j, 4) _
        And ThisWorkbook.Worksheets("New Entries").Cells(i, 5) = ThisWorkbook.Worksheets("Plant tracker").Cells(j, 5) Then
            ThisWorkbook.Worksheets("New Entries").Cells(i, 7).Interior.Color = RGB(0, 0, 255)
            ThisWorkbook.Worksheets("New Entries").Cells(i, 8) = ThisWorkbook.Worksheets("Plant tracker").Cells(j, 7)
            ThisWorkbook.Worksheets("New Entries").Cells(i, 9) = 1
    Else: For k = 1 To 9
            ThisWorkbook.Worksheets("New Entries").Cells(i, k).Interior.Color = RGB(0, 250, 0)
          Next k
    End If
 
Next j
Next i
 
 
 
End Sub

[LeForestier]

Bonjour,
essaye avec cette sub, simplifié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
Sub Button1_Click()
Dim Plant As Worksheet
Dim i, j, k, l, dercellnew, dercellrecord As Long, e As Integer, Test As Integer
    Set Plant = Sheets("Plant tracker")
    dercellrecord = Plant.Range("A65536").End(xlUp).Row
    With Sheets("New Entries")
        dercellnew = .Range("A65536").End(xlUp).Row
        For i = dercellnew To 4 Step -1
            For j = dercellrecord To 10 Step -1
                Test = 0
                For e = 2 To 5: Test = Test + Abs(.Cells(i, e) = Plant.Cells(j, e)) : Next e
                If Test = 4 And .Cells(i, 7) = Plant.Cells(j, 7) Then
                   .Rows(i).Delete
                ElseIf Test = 4 Then
                        .Cells(i, 7).Interior.Color = RGB(0, 0, 255)
                        .Cells(i, 8) = Plant.Cells(j, 7)
                        .Cells(i, 9) = 1
                Else
                    .Range(.Cells(i, 1), .Cells(i, 9)).Interior.Color = RGB(0, 250, 0)
                End If
            Next j
        Next i
    End With
End Sub

A+