Verifier 2 cellules et supprimer une ligne
Bonjour forum
puisque je suis nouveau sur vba, jais 2 petit problemes , jais 3 feuilles ,je veux un macro qui verifier 2 cellules si sont les memes supprimes la ligne de la 1er cellule
aussi un macro qui verifie tous les lignes d'un tableau si ila ya la condition copier les lignes sur un 2eme tableau ,(le problem toute fois une nouvelle ligne s'ajoute ila recopier toutes les lignes)
* historique analyse
Dim wk_fichier As Workbook
Dim ws_panne As Worksheet
Dim ws_analyse As Worksheet
Dim lstrw_histopanne, lstrw_histoanalyse As Long
Dim ligne_coller As Long
'definir les variables fichiers et onglets
Set wk_fichier = ActiveWorkbook
Set ws_panne = wk_fichier.Worksheets(4)
Set ws_analyse = wk_fichier.Worksheets(5)
'identifier dernière ligne colone A sheets("historique de panne")
lstrw_histopanne = ws_panne.Cells(Rows.Count, 1).End(xlUp).Row
'commencer la boucle sur les lignes
For i = 7 To lstrw_histopanne
'identifier le statut et si actif,copier coller en sheets("historique analyse")
If ws_panne.Cells(i, 8) = "oui" Then
'identifier derniere ligne colonne A sheets("historique analyse")
' lstrw_histoanalyse = ws_analyse.Cells(Rows.Count, 1).End(xlUp).Row
lstrw_histoanalyse = ws_analyse.Cells(i + 1, 1).End(xlUp).Row
ligne_coller = lstrw_histoanalyse + 1
'copier coller de la cellule
ws_analyse.Cells(ligne_coller, 1) = ws_panne.Cells(i, 5)
End If
Next
End Sub
* effacer la ligne entière
Worksheets("I.prod").Select
'effacer toute la ligne
For i = 8 To lstrw
If ActiveCell.Value <> " " Then
ActiveCell.EntireRow.Delete
End If
Next i
End Sub
Bonjour Youness, bonjour le forum,
En pièce jointe ton fichier modifié avec le code ci-dessous :
Option Explicit
Private O1 As Worksheet 'déclare la variable O1 (Onglet 1)
Private O2 As Worksheet 'déclare la variable O2 (Onglet 2)
Private O3 As Worksheet 'déclare la variable O3 (Onglet 1)
Private T1 As ListObject 'déclare la variable T1 (Tableau structuré 1)
Private T2 As ListObject 'déclare la variable T2 (Tableau structuré 2)
Private T3 As ListObject 'déclare la variable T3 (Tableau structuré 3)
Sub Macro1()
Dim I As Integer 'déclare la variable I (Incrément1)
Dim J As Integer 'déclare la variable J (incrément)
Set O1 = Worksheets("Sheet1") 'définit l'onglet O1
Set O2 = Worksheets("Sheet2") 'définit l'onglet O2
Set O3 = Worksheets("Sheet3") 'définit l'onglet O3
Set T1 = O1.ListObjects(1) 'définit le tableau structuré T1
Set T2 = O2.ListObjects(1) 'définit le tableau structuré T2
Set T3 = O3.ListObjects(1) 'définit le tableau structuré T3
For I = T2.ListRows.Count To 1 Step -1 'boucle 1 : inversée sur toutes les ligne I de T2 (de la dernière à la première)
For J = 1 To T1.ListRows.Count 'boucle 2 : sur toutes les ligne J de T1
'si la donnée ligne J colonne 1 de T1 est égale à la donnée ligne I de T2, supprime la ligne J de t1
If T1.DataBodyRange(J, 1) = T2.DataBodyRange(I, 1) Then T1.ListRows(J).Delete
Next J 'prochaine ligne de la boucle 2
Next I 'prochaine ligne de la boucle 1
End Sub
Sub Macro2()
Dim R As Range 'déclare la variable 1 (onglet 1)
Dim LI As Integer 'déclare la variable 1 (onglet 1)
Dim I As Integer 'déclare la variable 1 (onglet 1)
Set O1 = Worksheets("Sheet1") 'définit l'onglet O1
Set O2 = Worksheets("Sheet2") 'définit l'onglet O2
Set O3 = Worksheets("Sheet3") 'définit l'onglet O3
Set T1 = O1.ListObjects(1) 'définit le tableau structuré T1
Set T2 = O2.ListObjects(1) 'définit le tableau structuré T2
Set T3 = O3.ListObjects(1) 'définit le tableau structuré T3
For I = 1 To T2.ListRows.Count 'boucle sur toutes les ligne I de T2
If T2.DataBodyRange(I, 3) = "oui" Then 'condition 1 : si la donnée ligne I colonne 3 de T2 est égale à "oui"
Set R = T3.ListColumns(1).Range.Find("") 'définit la recherche R (recherche du vide dans la colonne 1 de t3)
If R Is Nothing Or T3.ListRows.Count = 0 Then 'condition 2 : si occunne occurrence n'est trouvée ou si T3 ne contient pas de ligne
T3.ListRows.Add 'ajoute une ligne à T3
LI = T3.ListRows.Count 'définit la ligne LI
Else 'sinon (au moins une occurrence trouvée)
LI = R.Row - T3.HeaderRowRange.Row 'définit la ligne LI
End If 'fin de la condition 2
T2.ListRows(I).Range.Copy T3.DataBodyRange(LI, 1) 'copie la ligne I de t2 et la colle dans la donnée ligne LI colonne 1 de t3
End If 'fin de la condition 1
Next I 'prochaine ligende la boucle
End Sub
Merci pour votre repense le seul probleme pour le 2eme macro cest quand j'ajoute une autre ligne avec la condition "oui" et je click il recopier tous les lignes depuis le debut, je veux just copier la dernier ligne ajouter
Merci
Bonjour Youness, bonjour le forum,
Le code modifié. Le tableau dans Sheet3 est d'abord complètement effacé avant de recopier les lignes :
Sub Macro2()
Dim R As Range 'déclare la variable 1 (onglet 1)
Dim LI As Integer 'déclare la variable 1 (onglet 1)
Dim I As Integer 'déclare la variable 1 (onglet 1)
Set O1 = Worksheets("Sheet1") 'définit l'onglet O1
Set O2 = Worksheets("Sheet2") 'définit l'onglet O2
Set O3 = Worksheets("Sheet3") 'définit l'onglet O3
Set T1 = O1.ListObjects(1) 'définit le tableau structuré T1
Set T2 = O2.ListObjects(1) 'définit le tableau structuré T2
Set T3 = O3.ListObjects(1) 'définit le tableau structuré T3
T3.DataBodyRange.Delete 'supprime les données du tableau structuré T3 <----- ici
For I = 1 To T2.ListRows.Count 'boucle sur toutes les ligne I de T2
If T2.DataBodyRange(I, 3) = "oui" Then 'condition 1 : si la donnée ligne I colonne 3 de T2 est égale à "oui"
Set R = T3.ListColumns(1).Range.Find("") 'définit la recherche R (recherche du vide dans la colonne 1 de t3)
If R Is Nothing Or T3.ListRows.Count = 0 Then 'condition 2 : si occunne occurrence n'est trouvée ou si T3 ne contient pas de ligne
T3.ListRows.Add 'ajoute une ligne à T3
LI = T3.ListRows.Count 'définit la ligne LI
Else 'sinon (au moins une occurrence trouvée)
LI = R.Row - T3.HeaderRowRange.Row 'définit la ligne LI
End If 'fin de la condition 2
T2.ListRows(I).Range.Copy T3.DataBodyRange(LI, 1) 'copie la ligne I de t2 et la colle dans la donnée ligne LI colonne 1 de t3
End If 'fin de la condition 1
Next I 'prochaine ligende la boucle
End Sub
il donne une erreur
T3.DataBodyRange.Delete 'supprime les données du tableau structuré T3 <----- ici•••
Object variable or with block variable not set
bonjour,
a mon avis, il est important de sortir le dernier boucle dès qu'on a supprimer une ligne !!!
Aussi le dernier boucle ne doit pas faire tout le traject, seuelement jusqu'à I-1
Sub Macro1()
Dim I As Integer, J As Integer, sh
For Each sh In Array("sheet1", "sheet2", "sheet3") 'boucle des feuilles
With Sheets(CStr(sh)).ListObjects(1)
For I = .ListRows.Count To 2 Step -1 'boucle 1 : inversée sur toutes les ligne I de T2 (de la dernière à la première)
For J = 1 To I - 1 'boucle 2 : sur toutes les ligne J de T1
'si la donnée ligne J colonne 1 de T1 est égale à la donnée ligne I de T2, supprime la ligne J de t1
If .DataBodyRange(J, 1) = .DataBodyRange(I, 1) Then .ListRows(I).Delete: Exit For 'IMPORTANT de sortir le boucle
Next J 'prochaine ligne de la boucle 2
Next I 'prochaine ligne de la boucle 1
End With
Next
End Sub
je ne comprends pas le but exacte du 2ieme macro, mais pour vous donner un idée plus structuré
Sub macro2()
Dim LO_Panne, LO_Analyse, LO_Synthese, LO, r As Variant, i
Set LO_Panne = ThisWorkbook.Sheets("sheet1").ListObjects(1) 'les 3 listobjects
Set LO_Analyse = ThisWorkbook.Sheets("sheet3").ListObjects(1)
Set LO_Synthese = ThisWorkbook.Sheets("sheet2").ListObjects(1)
With LO_Synthese
If .ListRows.Count Then .DataBodyRange.Delete 'demarrer avec celui-ci vide
End With
For Each LO In Array(LO_Panne, LO_Analyse) 'les 2 autres LO
With LO
For i = .ListRows.Count To 1 Step -1 'commencer avec le dernier et reculer
If StrComp(.DataBodyRange(i, 3).Value, "oui", vbTextCompare) = 0 Then
r = "x" 'commencer avec r as string
If LO_Synthese.ListRows.Count <> 0 Then r = Application.Match(.DataBodyRange(i, 1), LO_Synthese.ListColumns("Column1").DataBodyRange, 0) 'r=ligne correspondant dans lo_synthese
If Not IsNumeric(r) Then 'ligne correspondant n'est pas trouvée
LO_Synthese.ListRows.Add 'ajouter nouvelle ligne dans lo_synthese
r = LO_Synthese.ListRows.Count 'r=derniere ligne
End If
LO_Synthese.ListRows(r).Range.Value = LO.ListRows(i).Range.Value 'copier les valeurs vers lo_synthese
LO.ListRows(i).Delete
End If
Next
End With
Next
End Sub
Merci beaucoup pour vos repenses
pour le macro 2 de ThauThème marche bien le seul probleme c'est quond je click pour la 2eme fois il recopier le tableau des le debut
par contre je veux apres lajoute dune nouvelle ligne avec la condition "oui" je click pour la 2eme fois++ il copier juste cette derniere ligne ajoutee sur le 2eme tableau Merci
Bonjour le fil, bonjour le forum,
Puisqu'il recopie tout le tableau ça revient au même sauf l'ordre qui n'est pas respecté. Mais si tu veux cela il faudra ajouter un marqueur qui permettra de repérer les ligne déjà préalablement copiées. Dis-moi...
j'ai revérifié, OUI il marche tres bien Merci beaucoup pour vos repenses
Re,
En pièce jointe ton fichier modifié, l'ordre est respecté et le marqueur est la police en gras quand la copie est faire...
ah parfait, un grand grand merci
re,
la moitié des macros est definir le truc, faitez-cela dans un macro commun, est pourquoi declarer les feuilles, quand c'est uniquement les listobjects qui t'intéressent ? Un listobject est vraiment un outil facile à manipuler.
Option Explicit
Private O1 As Worksheet, O2 As Worksheet, O3 As Worksheet 'déclare la variable O3 (Onglet 1)
Private T1 As ListObject, T2 As ListObject, T3 As ListObject 'déclare la variable T3 (Tableau structuré 3)
Sub Commun(b)
If b Then 'si vrai = definir ces variables
Set O1 = Worksheets("Sheet1") 'définit l'onglet O1
Set O2 = Worksheets("Sheet2") 'définit l'onglet O2
Set O3 = Worksheets("Sheet3") 'définit l'onglet O3
Set T1 = O1.ListObjects(1) 'définit le tableau structuré T1
Set T2 = O2.ListObjects(1) 'définit le tableau structuré T2
Set T3 = O3.ListObjects(1) 'définit le tableau structuré T3
Else 'si faux reset ces variables
Set O1 = Nothing
Set O2 = Nothing
Set O3 = Nothing
Set T1 = Nothing
Set T2 = Nothing
Set T3 = Nothing
End If
End Sub
Sub Macro1()
Dim I As Integer 'déclare la variable I (Incrément1)
Dim J As Integer 'déclare la variable J (incrément)
Commun True
For I = T2.ListRows.Count To 1 Step -1 'boucle 1 : inversée sur toutes les ligne I de T2 (de la dernière à la première)
For J = 1 To T1.ListRows.Count 'boucle 2 : sur toutes les ligne J de T1
'si la donnée ligne J colonne 1 de T1 est égale à la donnée ligne I de T2, supprime la ligne J de t1
If T1.DataBodyRange(J, 1) = T2.DataBodyRange(I, 1) Then T1.ListRows(J).Delete
Next J 'prochaine ligne de la boucle 2
Next I 'prochaine ligne de la boucle 1
Commun False
End Sub
Bonjour le fil, bonjour le forum,
@BsAlv, j'ai peur pour les mouches...