[RESOLU]recherche d'un nombre entre deux documents excel

smallville

XLDnaute Nouveau
Bonjour à tous,

Excusez-moi pour l'intitulé il ne reflète pas trop ce dont je parle ici.

Donc j'aimerais effectuer un test sur une colonne pour trouver la lettre "D", jusqu'ici rien de compliqué mais,
si la lettre "D" est trouvée alors -----> mettre en mémoire le numéro associé à la ligne ou il y à la lettre D sachant que ce numéro se trouve dans une colonne à coté. Une fois en mémoire il faudra rechercher ce numéro dans un autre document pour supprimer la ligne associé.

Voyez plutôt le fichier joint, il est peut-être plus explicite...
si quelqu'un à une idée pour me coder ça en VBA.
Merci d'avance pour votre aide !
 

Fichiers joints

Dernière édition:

Robert

XLDnaute Barbatruc
Re : recherche d'un nombre entre deux documents excel

Bonjour Smallville, bonjour le forum,

peut-être comme ça :
Code:
Sub Macro1()
Dim CO As Workbook 'déclare la variable CO (Classeur Origine)
Dim OO As Object 'déclare la variable OO (Onglet Origine)
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim CE As Workbook 'déclare la variable CE (Classeur Effacement)
Dim OE As Object 'déclare la variable OE (Onglet Effacement)
Dim R As Range 'déclare la variable R (Recherche)
Dim PA As String 'déclare la variable PA (Première Adresse)
Dim I As Integer 'déclare la variable I (Incrément)
Dim TD() As String 'déclare le tableau de variables TD (Tablweau des D)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim PLV As Range 'déclare la variable PLV (PLage Visible)

Set CO = ThisWorkbook 'définit le classeur origine CO
Set OO = CO.Sheets("Feuil1") 'définit l'onglet origine oo
CH = CO.Path 'définit le chemin d'accès CH
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set CE = Workbooks("Classeur2.xlsx") 'définit le classeur d'effacement CE (génère une erreur si ce classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'efface l'erreur
    Workbooks.Open (CH & "/Classeur2.xlsx") 'ouvre le classeur "classeur2.xlsx"
    Set CE = ActiveWorkbook 'définit le classeur d'effacement CE
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OE = CE.Sheets("Feuil1") 'définit l'onglet d'effacement OE
Set R = OO.Columns(9).Find("D", , xlValues, xlWhole) 'de'finit la recherche R (Recherche "D" dans la colonne 9 (=I) de l'onglet OO
If Not R Is Nothing Then 'condition : si il existe au moins une occurrence trouvée
    PA = R.Address 'définit l'adresse PA de la première occurrence trouvée
    Do 'exécute
        ReDim Preserve TD(I) 'redimensione le tableau de variable TD
        TD(I) = R.Offset(0, -3) 'ajoute la variable indéxée TD
        I = I + 1 'incrémente I
        Set R = OO.Columns(9).FindNext(R) 'redéfinit la recherche R (occurrence suivante)
    Loop While Not R Is Nothing And R.Address <> PA 'boucle tant qu'il existe de nouvelles occurrences ailleurs qu'en PA
Else 'sinon (si aucune occurrence trouvée)
    Exit Sub 'sort de la procédure
End If
DL = OE.Cells(Application.Rows.Count, 6).End(xlUp).Row 'définit la dernière ligne éditée Dl de la colonne 6 (=F) de l'onglet OE
Set PL = OE.Range("A2:A" & DL) 'définit la plage PL
For I = 0 To UBound(TD) 'boucle sur tous les éléments du tableau de variables TD
    OE.Range("A1").AutoFilter Field:=6, Criteria1:=TD(I) 'filtre la colonne 6 (=F) de l'onglet OE avec TD(I) comme critère
    Set PLV = PL.SpecialCells(xlCellTypeVisible) 'définit la plage PLV (cellules visibles (non filtrées) de la plage PL
    PLV.EntireRow.Delete 'supprime les lignes entières de la plage PLV
    OE.Range("A1").AutoFilter 'supprime le filtre automatique
Next I 'prochain élément de la boucle
CE.Save 'enregistre le classeur d'effacement
End Sub
 

smallville

XLDnaute Nouveau
Re : recherche d'un nombre entre deux documents excel

Bonjour Robert, Bonjour le Forum.

Merci Robert pour ton aide, ça fonctionne très bien mais pas dans le bon fichier. Désolé c'est ma faute je me suis trompé, j'ai inversé le Classeur 1 et le 2

Donc, C'est le classeur 2, le document de base.C'est dans ce classeur que le test est effectué (pour trouver la lettre D) il ne doit pas être modifier et le document est fermé par défaut.
Le Classeur 1 contiens la macro et est donc toujours ouvert, c'est dans ce document que les lignes doivent être supprimées.

Si tu pouvais modifier le code en conséquence parce-que moi j'y suis pas arriver....

Merci d'avance
 

Robert

XLDnaute Barbatruc
Re : recherche d'un nombre entre deux documents excel

Bonjour Smallville, bonjour le forum,

Ce code à placer dans le fichier Classeur2 qui, du fait, devient .xlsm :

Code:
Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Object 'déclare la variable OS (Onglet Source)
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim CD As Workbook 'déclare la variable CD (Classeur Effacement)
Dim OD As Object 'déclare la variable OD (Onglet Effacement)
Dim R As Range 'déclare la variable R (Recherche)
Dim PA As String 'déclare la variable PA (Première Adresse)
Dim I As Integer 'déclare la variable I (Incrément)
Dim TD() As String 'déclare le tableau de variables TD (Tablweau des D)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim PLV As Range 'déclare la variable PLV (PLage Visible)

Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Sheets("Feuil1") 'définit l'onglet source OS
CH = CS.Path 'définit le chemin d'accès CH
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set CD = Workbooks("Classeur1.xlsx") 'définit le classeur de données CD (génère une erreur si ce classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'efface l'erreur
    Workbooks.Open (CH & "/Classeur1.xlsx") 'ouvre le classeur "classeur1.xlsx"
    Set CD = ActiveWorkbook 'définit le classeur de données CD
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OD = CD.Sheets("Feuil1") 'définit l'onglet de données OD
Set R = OD.Columns(9).Find("D", , xlValues, xlWhole) 'de'finit la recherche R (Recherche "D" dans la colonne 9 (=I) de l'onglet OD
If Not R Is Nothing Then 'condition : si il existe au moins une occurrence trouvée
    PA = R.Address 'définit l'adresse PA de la première occurrence trouvée
    Do 'exécute
        ReDim Preserve TD(I) 'redimensione le tableau de variable TD
        TD(I) = R.Offset(0, -3) 'ajoute la variable indéxée TD
        I = I + 1 'incrémente I
        Set R = OD.Columns(9).FindNext(R) 'redéfinit la recherche R (occurrence suivante)
    Loop While Not R Is Nothing And R.Address <> PA 'boucle tant qu'il existe de nouvelles occurrences ailleurs qu'en PA
Else 'sinon (si aucune occurrence trouvée)
    Exit Sub 'sort de la procédure
End If
DL = OS.Cells(Application.Rows.Count, 6).End(xlUp).Row 'définit la dernière ligne éditée Dl de la colonne 6 (=F) de l'onglet OS
Set PL = OS.Range("A2:A" & DL) 'définit la plage PL
For I = 0 To UBound(TD) 'boucle sur tous les éléments du tableau de variables TD
    OS.Range("A1").AutoFilter Field:=6, Criteria1:=TD(I) 'filtre la colonne 6 (=F) de l'onglet OS avec TD(I) comme critère
    Set PLV = PL.SpecialCells(xlCellTypeVisible) 'définit la plage PLV (cellules visibles (non filtrées) de la plage PL
    PLV.EntireRow.Delete 'supprime les lignes entières de la plage PLV
    OS.Range("A1").AutoFilter 'supprime le filtre automatique
Next I 'prochain élément de la boucle
CD.Close SaveChanges:=False 'ferme le classeur de données sans enregistrer
CS.Save 'enregistre le classeur source CS
End Sub
Parfois, je me demande à quoi ça sert que je commente mes codes...
 

smallville

XLDnaute Nouveau
Re : recherche d'un nombre entre deux documents excel

Bonjour Robert, Bonjour le Forum.

AAhhh non, la macro doit se trouver dans le Classeur 1 j'ai pas le choix. Classeur dans lequel les lignes sont à supprimer, je ne peut pas du tout touché au classeur 2.
La première version étais bien mais la macro cherche la lettre D dans le Classeur 1 et supprime la ligne associer dans le classeur 2.
Il faudrait que la macro cherche dans le Classeur 2 et supprime dans le classeur 1 ou est coder la macro (impératif).

désolé d’être casse bonbon mais j'ai pas trop le choix ...
Merci Encore.
 

Robert

XLDnaute Barbatruc
Re : recherche d'un nombre entre deux documents excel

Bonjour Smallville, bonjour le forum,

Mais non t'es pas casse bonbon, juste un peu feignasse ! Car avec le code commenté comme il l'est tu devrais y arriver tout seul ou, du moins, essayer... Et moi j'ai enfin compris qu'il fallait juste inverser les classeurs !
Voici le code à mettre dans le fichier Classeur2.xlsm :

Code:
Sub Macro1()
Dim CS As Workbook 'déclare la variable CS (Classeur Source)
Dim OS As Object 'déclare la variable OS (Onglet Source)
Dim CH As String 'déclare la variable CH (CHemin d'accès)
Dim CD As Workbook 'déclare la variable CD (Classeur Effacement)
Dim OD As Object 'déclare la variable OD (Onglet Effacement)
Dim R As Range 'déclare la variable R (Recherche)
Dim PA As String 'déclare la variable PA (Première Adresse)
Dim I As Integer 'déclare la variable I (Incrément)
Dim TD() As String 'déclare le tableau de variables TD (Tablweau des D)
Dim DL As Integer 'déclare la variable DL (Dernière Ligne)
Dim PL As Range 'déclare la variable PL (PLage)
Dim PLV As Range 'déclare la variable PLV (PLage Visible)

Set CS = ThisWorkbook 'définit le classeur source CS
Set OS = CS.Sheets("Feuil1") 'définit l'onglet source OS
CH = CS.Path 'définit le chemin d'accès CH
On Error Resume Next 'gestion des erreurs (en cas d'erreur passe à la ligne suivante)
Set CD = Workbooks("Classeur1.xlsx") 'définit le classeur de données CD (génère une erreur si ce classeur n'est pas ouvert)
If Err <> 0 Then 'condition : si une erreur a été générée
    Err.Clear 'efface l'erreur
    Workbooks.Open (CH & "/Classeur1.xlsx") 'ouvre le classeur "classeur1.xlsx"
    Set CD = ActiveWorkbook 'définit le classeur de données CD
End If 'fin de la condition
On Error GoTo 0 'annule la gestion des erreurs
Set OD = CD.Sheets("Feuil1") 'définit l'onglet de données OD
Set R = OS.Columns(9).Find("D", , xlValues, xlWhole) 'de'finit la recherche R (Recherche "D" dans la colonne 9 (=I) de l'onglet OS
If Not R Is Nothing Then 'condition : si il existe au moins une occurrence trouvée
    PA = R.Address 'définit l'adresse PA de la première occurrence trouvée
    Do 'exécute
        ReDim Preserve TD(I) 'redimensione le tableau de variable TD
        TD(I) = R.Offset(0, -3) 'ajoute la variable indéxée TD
        I = I + 1 'incrémente I
        Set R = OS.Columns(9).FindNext(R) 'redéfinit la recherche R (occurrence suivante)
    Loop While Not R Is Nothing And R.Address <> PA 'boucle tant qu'il existe de nouvelles occurrences ailleurs qu'en PA
Else 'sinon (si aucune occurrence trouvée)
    Exit Sub 'sort de la procédure
End If
DL = OD.Cells(Application.Rows.Count, 6).End(xlUp).Row 'définit la dernière ligne éditée Dl de la colonne 6 (=F) de l'onglet OS
Set PL = OD.Range("A2:A" & DL) 'définit la plage PL
For I = 0 To UBound(TD) 'boucle sur tous les éléments du tableau de variables TD
    OD.Range("A1").AutoFilter Field:=6, Criteria1:=TD(I) 'filtre la colonne 6 (=F) de l'onglet OD avec TD(I) comme critère
    Set PLV = PL.SpecialCells(xlCellTypeVisible) 'définit la plage PLV (cellules visibles (non filtrées) de la plage PL
    PLV.EntireRow.Delete 'supprime les lignes entières de la plage PLV
    OD.Range("A1").AutoFilter 'supprime le filtre automatique
Next I 'prochain élément de la boucle
End Sub
 

smallville

XLDnaute Nouveau
Re : recherche d'un nombre entre deux documents excel

Bonjour Robert, Bonjour le Forum.

Merci d'avoir essayer Robert mais sa ne fonctionne pas, de plus JE NE PEUT PAS TOUCHER AU CLASSEUR 2, je ne peut donc pas codé dans le Classeur 2 d’où l’internet de travailler dans le premier. Je ne voudrais pas abusé donc je vais repartir du premier code je devrais pouvoir arriver à en faire quelque-chose.
Merci encore pour ton aide.
 

Robert

XLDnaute Barbatruc
Re : recherche d'un nombre entre deux documents excel

Bonjour Smallville, bonjour le forum,

Oui parce qu moi je n'y comprends plus rien là... Je passe la main.
 

Discussions similaires


Haut Bas