[XL-365] Problème VBA: Supprimer + compter les lignes

Citation:
Envoyé par New_VBA_User
Bonjour,

A tester:
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
 
Private Sub CommandButton_CleanDescription_Click()
 
Dim DerniereLigne As Long, I As Long, J As Long, Compteur As Long
Dim AireData As Range, AireDescriptions As Range
 
   'Application.ScreenUpdating = False
 
   With Sheets("Description")
       DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
       Set AireDescriptions = .Range(.Cells(2, 1), .Cells(DerniereLigne, 1))
   End With
 
   With Sheets("Filtered Data SAP")
       DerniereLigne = .Cells(.Rows.Count, 1).End(xlUp).Row
       Set AireData = .Range(.Cells(2, 3), .Cells(DerniereLigne, 3))
   End With
 
   Compteur = 0
   For I = AireData.Count To 1 Step -1
       For J = 1 To AireDescriptions.Count
           If InStr(1, AireData(I), AireDescriptions(J), vbTextCompare) > 0 Then
             Compteur = Compteur + 1
             'AireData(I).EntireRow.Delete
           End If
       Next J
  Next I
 
  MsgBox "Nombre de lignes supprimées : " & Compteur & " / " & AireData.Count, vbInformation
 
  'Application.ScreenUpdating = True
 
  Set AireDescriptions = Nothing
  Set AireData = Nothing
 
End Sub