Discussion :

[steelydan]

Bonjour à tous,

Voila je débute dans VBA (8 heures de cours intensifs), j’ai quelque notions mais pas de pratique.

J’ai un fichier .xls contenant 2 feuilles:

• Une première feuille « Tabelle1 » dite référence contenant plusieurs items uniques (environs 200), Colonnes de Réf “C2”.
• Une deuxième feuille « Tabelle2 » dite Data contenant plusieurs items (environs 30000) avec possibilité de doublons et beaucoup non présents dans la feuille de Référence (Tabelle 1), colonnes de Réf “E2”.

Les items dans "C2" et "E2" sont des valeurs numériques sur 5 digits.

Ce qui m’intéresse serait de faire une macro qui supprime toutes les lignes de la Feuil2 qui ne sont pas présents dans la Tabelle1. j'aimerais aussi conservé même les doublons qui sont présents dans la Tabelle1.

Si quelqu'un pouvait m'aider à réaliser cette macro, je suis preneur de toutes informations.


J’ai commencé par ceci mais je patine totalement :

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
Sub Supprime_loop_non_reseau()
 
Dim loop_Reseau As String
Dim loop_Ref As String
Dim Mycheck
Dim Rng_Reseau As Range
Dim Rng_Ref As Range
 
Workbooks("testloop.xls").Sheets("Tabelle2").Activate
 
Set Rng_Reseau = Range("c2").CurrentRegion
Rng_Reseau.Value = loop_Reseau
 
Workbooks("testloop.xls").Sheets("Tabelle1").Activate
Set Rng_Ref = Range("e2")
 
While ActiveCell.Value <> ""
 
    Mycheck = loop_Reseau Like loop_Ref
 
Wend
 
End Sub

[Yoyo57]

Bonjour steelydan,

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
Dim i as Long, j as Byte
Dim Ws as WorkSheet
Dim Wc as WorkSheet
Dim RefTrouvee as Boolean
 
Set Ws = Workbooks("testloop.xls").Sheets("Tabelle2")
Set Wc = Workbooks("testloop.xls").Sheets("Tabelle1")
 
i = 1
Do While Ws.Range("E2").Cells(i, 1) <> ""
    j = 1
    RefTrouvee = False
    Do While Wc.Range("C2").Cells(j, 1) <> "" and RefTrouvee = False
        If Ws.Range("E2").Cells(i,1) = Wc.Range("C2").Cells(j, 1) Then
            RefTrouvee = True
        End If
        j = j + 1
    Loop
    If RefTrouvee = False Then
        Ws.Rows(i+1).Delete
    Else
        i = i + 1
    End If
Loop

Je n'ai pas testé le code car je n'ai pas tes données, mais dis moi si tu as une erreur et si ca fait ce que tu veux.

En gros, de ce que j'ai compris, si une référence de la feuille 2 est présente dans la feuille 1, on la garde, sinon on supprime la ligne dans la feuille 2.

[steelydan]

Salut Yoyo,

J'ai lancé la macro la premiere fois sur une copie du fichier cela a supprimé toute les lignes sur tabellle 2.

j'ai effectué une petite modif ensuite, en inversant partout le E2 par C2 et vice et versa.

Et la Nickel super tout fonctionne à merveille, t'es un crack.

Je te remercie enormément.

Pour infos pour environs 30000 lignes et 244 en Ref, cela a duré environs 10 min.


Je m'appelle karim j'ai omis de l'indiquer.

Merci encore.

[Yoyo57]

Salut Karim,

10 minutes c'est long... Je sais pas si tu dois refaire cà à l'avenir mais tu peux ajouter

Code :

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

Application.ScreenUpdating = False

au tout début de la macro pour gagner du temps d'exécution

A la fin de la macro, je te conseille un

Code :

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

1
2
Application.ScreenUpdating = True
Call MsgBox("Opérations réalisées avec succès", vbOkOnly + vbInformation, "Traitement terminé")

Afin de savoir quand ton traitement est terminé.

Autre précision :

Si tu as moins de 32768 lignes à traiter, alors i peut être un entier au lieu d'un Long

Code :

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

Dim i as Integer

De plus, si tu dépasses 255 réfs dans ta feuille Tabelle1, alors j devra obligatoirement être un entier (sinon tu vas avoir une erreur à l'exécution) et non un Byte

Code :

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

Dim j as Integer

Un Byte ne peut dépasser 255 et un Integer ne peut dépasser 32768.

[mercatog]

Ma proposition plus rapide

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
Sub SupprAbs()
Dim LastLig1 As Long, LastLig2 As Long, i As Long
Dim c As Range
 
Application.ScreenUpdating = False
LastLig2 = Sheets("Tabelle2").Cells(Rows.Count, "C").End(xlUp).Row
If LastLig2 > 2 Then
    With Sheets("Tabelle1")
        LastLig1 = .Cells(Rows.Count, "E").End(xlUp).Row
        If LastLig1 > 2 Then
            For i = LastLig1 To 2 Step -1
                Set c = Sheets("Tabelle2").Range("C2:C" & LastLig2).Find(What:=.Range("E" & i).Value, LookIn:=xlValues, Lookat:=xlWhole)
                If c Is Nothing Then .Rows(i).Delete
            Next i
        End If
    End With
End If
End Sub

Pour les suppressions de lignes, il est plus facile de commencer du bas et remonter

[steelydan]

Salut Lionel,

Nickel Lionel ,

Comme tu peux le voir ci-dessous petite inversion avec Tabelle1 et 2 , et champs E et C.

Après modifs elle s'execute en moins d'une minute, Tip Top !

Une petite question si ton temps te le permets comment pourrait-on traduire dans un langage simple la ligne de commande suivante, quelle est instruction qui fait la comparaison entre E et C :

Code :

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

Set c = Sheets("Tabelle1").Range("E2:E" & LastLig2).Find(What:=.Range("C" & i).Value, LookIn:=xlValues, Lookat:=xlWhole)

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
Sub SupprAbs()
Dim LastLig1 As Long, LastLig2 As Long, i As Long
Dim c As Range
 
Application.ScreenUpdating = False
LastLig1 = Sheets("Tabelle1").Cells(Rows.Count, "C").End(xlUp).Row
If LastLig1 > 2 Then
    With Sheets("Tabelle2")
        LastLig2 = .Cells(Rows.Count, "E").End(xlUp).Row
        If LastLig2 > 2 Then
            For i = LastLig2 To 2 Step -1
                Set c = Sheets("Tabelle1").Range("E2:E" & LastLig2).Find(What:=.Range("C" & i).Value, LookIn:=xlValues, Lookat:=xlWhole)
                If c Is Nothing Then .Rows(i).Delete
            Next i
        End If
    End With
End If
End Sub

Merci à toi Mercatog...
Je suis un peu perdu avec ces messages.
Merci en tous les cas Messieurs.

[mercatog]

Code :

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

Set c = Sheets("Feuil1").Range("E2:E100").Find(What:=Mot, LookIn:=xlValues, Lookat:=xlWhole)

Dans la plage E2:E100 de la feuille Feuil1 on cherche Mot.
Pour les paramètres lookin i lookat (il y en a d'autre) fait un F1 sur le mot find