Etant d=E9butant en VBA, j'ai r=E9cup=E9r=E9 une macro permettant de g=E9rer
les doublons dont une personne faisait allusion sur un pr=E9c=E9dent
post, macro r=E9cup=E9r=E9 sur le site de Laurent Longre.
En th=E9orie, elle permet de supprimer des doublons dans un tableau
excel, mais =E9galement les effacer sans les supprimer. C'est cette
fonctionnalit=E9 qui m'int=E9resse : j'aimerais juste effacer les lignes
des doublons sans les supprimer de mani=E8re =E0 pouvoir faire des
calculs de statistiques sur un autre onglet. En supprimant les lignes,
les r=E9f=E9rences me permettant de calculer mes statistiques ne
fonctionnent plus...Mais en utilisant la macro d'effacement des lignes,
ca ne fonctionne pas...
J'ai un bouton sur ma feuille o=F9 figure le tableau avec les doublons,
ce bouton lance la macro Unique_Efface mais celle-ci supprime les
doublons...Je dois mal utiliser cette macro. Ci-dessous figure le code
de toute la macro.
__________________
Function SupprDoublons(Plage As Range, Optional Modif As Integer) As
Long
Dim Temp As Range
Dim MiseAJourEcran As Boolean, Recalcul As Boolean
'On Error GoTo Fin
' Sauvegarde des param=E8tres actuels d'affichage et de recalcul
' If Application.ScreenUpdating Then
' MiseAJourEcran =3D True
' Application.ScreenUpdating =3D False
' End If
' If Application.Calculation =3D xlCalculationAutomatic Then
' Recalcul =3D True
' Application.Calculation =3D xlCalculationManual
' End If
' D=E9termination de la plage d'extraction temporaire (Temp),
' ex=E9cution du filtre et d=E9placement vers la plage d'origine
With Plage
Set Temp =3D .Worksheet.Cells(.SpecialCells(xlCellTypeLastCell). _
Row + 1, 1).Resize(.Rows.Count, .Columns.Count)
'=2EAdvancedFilter Action:=3DxlFilterInPlace, Unique:=3DTrue
.AdvancedFilter Action:=3DxlFilterCopy, CopyToRange:=3DTemp, Unique:=3DTrue
End With
Temp.Cut Plage
' Traitement des lignes lib=E9r=E9es en fonction de 'Modif'
If Modif And WorksheetFunction.CountBlank(Temp) > 0 Then
With Range(Temp.End(xlDown)(2), Temp(Temp.Count))
If Modif =3D 1 Then .Delete xlShiftUp Else .EntireRow.Delete
End With
End If
' R=E9initialisation du UsedRange
Temp.Parent.UsedRange
Fin:
SupprDoublons =3D Err
If MiseAJourEcran Then Application.ScreenUpdating =3D True
If Recalcul Then Application.Calculation =3D xlCalculationAutomatic
End Function
Sub Unique_Efface()
SupprDoublons Selection
End Sub
Sub Unique_SupprPartielle()
SupprDoublons Selection, 1
End Sub
Sub Unique2_SupprEnti=E8re()
SupprDoublons Selection, 2
End Sub
'______________________________________________________________________
'La fonction 'SupprDoublons' repose sur l'uilisation d'un filtre
'=E9labor=E9 avec extraction sans doublon. Une plage temporaire (Temp)
'situ=E9e en-dessous de la derni=E8re cellule utilis=E9e dans la feuille
'de calcul re=E7oit les donn=E9es construites par le filtre, et son
'contenu est recopi=E9 dans un deuxi=E8me temps =E0 l'emplacement de la
'plage d'origine.
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
isabelle
bonjour thone,
met en commentaire cette commande : ' Temp.Cut Plage pour empecher qu'elle ne s'exécute.
isabelle
Bonjour,
Etant débutant en VBA, j'ai récupéré une macro permettant de gérer les doublons dont une personne faisait allusion sur un précédent post, macro récupéré sur le site de Laurent Longre. En théorie, elle permet de supprimer des doublons dans un tableau excel, mais également les effacer sans les supprimer. C'est cette fonctionnalité qui m'intéresse : j'aimerais juste effacer les lignes des doublons sans les supprimer de manière à pouvoir faire des calculs de statistiques sur un autre onglet. En supprimant les lignes, les références me permettant de calculer mes statistiques ne fonctionnent plus...Mais en utilisant la macro d'effacement des lignes, ca ne fonctionne pas... J'ai un bouton sur ma feuille où figure le tableau avec les doublons, ce bouton lance la macro Unique_Efface mais celle-ci supprime les doublons...Je dois mal utiliser cette macro. Ci-dessous figure le code de toute la macro. __________________
Function SupprDoublons(Plage As Range, Optional Modif As Integer) As Long
Dim Temp As Range Dim MiseAJourEcran As Boolean, Recalcul As Boolean
'On Error GoTo Fin
' Sauvegarde des paramètres actuels d'affichage et de recalcul ' If Application.ScreenUpdating Then ' MiseAJourEcran = True ' Application.ScreenUpdating = False ' End If ' If Application.Calculation = xlCalculationAutomatic Then ' Recalcul = True ' Application.Calculation = xlCalculationManual ' End If
' Détermination de la plage d'extraction temporaire (Temp), ' exécution du filtre et déplacement vers la plage d'origine With Plage Set Temp = .Worksheet.Cells(.SpecialCells(xlCellTypeLastCell). _ Row + 1, 1).Resize(.Rows.Count, .Columns.Count) '.AdvancedFilter Action:=xlFilterInPlace, Unique:=True .AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Temp, Unique:=True End With Temp.Cut Plage
' Traitement des lignes libérées en fonction de 'Modif' If Modif And WorksheetFunction.CountBlank(Temp) > 0 Then With Range(Temp.End(xlDown)(2), Temp(Temp.Count)) If Modif = 1 Then .Delete xlShiftUp Else .EntireRow.Delete End With End If
' Réinitialisation du UsedRange Temp.Parent.UsedRange
Fin: SupprDoublons = Err If MiseAJourEcran Then Application.ScreenUpdating = True If Recalcul Then Application.Calculation = xlCalculationAutomatic
End Function
Sub Unique_Efface() SupprDoublons Selection End Sub
Sub Unique_SupprPartielle() SupprDoublons Selection, 1 End Sub
Sub Unique2_SupprEntière() SupprDoublons Selection, 2 End Sub '______________________________________________________________________
'La fonction 'SupprDoublons' repose sur l'uilisation d'un filtre 'élaboré avec extraction sans doublon. Une plage temporaire (Temp) 'située en-dessous de la dernière cellule utilisée dans la feuille 'de calcul reçoit les données construites par le filtre, et son 'contenu est recopié dans un deuxième temps à l'emplacement de la 'plage d'origine.
__________________
Si vous pouvez m'aider!
Merci.
bonjour thone,
met en commentaire cette commande :
' Temp.Cut Plage
pour empecher qu'elle ne s'exécute.
isabelle
Bonjour,
Etant débutant en VBA, j'ai récupéré une macro permettant de gérer
les doublons dont une personne faisait allusion sur un précédent
post, macro récupéré sur le site de Laurent Longre.
En théorie, elle permet de supprimer des doublons dans un tableau
excel, mais également les effacer sans les supprimer. C'est cette
fonctionnalité qui m'intéresse : j'aimerais juste effacer les lignes
des doublons sans les supprimer de manière à pouvoir faire des
calculs de statistiques sur un autre onglet. En supprimant les lignes,
les références me permettant de calculer mes statistiques ne
fonctionnent plus...Mais en utilisant la macro d'effacement des lignes,
ca ne fonctionne pas...
J'ai un bouton sur ma feuille où figure le tableau avec les doublons,
ce bouton lance la macro Unique_Efface mais celle-ci supprime les
doublons...Je dois mal utiliser cette macro. Ci-dessous figure le code
de toute la macro.
__________________
Function SupprDoublons(Plage As Range, Optional Modif As Integer) As
Long
Dim Temp As Range
Dim MiseAJourEcran As Boolean, Recalcul As Boolean
'On Error GoTo Fin
' Sauvegarde des paramètres actuels d'affichage et de recalcul
' If Application.ScreenUpdating Then
' MiseAJourEcran = True
' Application.ScreenUpdating = False
' End If
' If Application.Calculation = xlCalculationAutomatic Then
' Recalcul = True
' Application.Calculation = xlCalculationManual
' End If
' Détermination de la plage d'extraction temporaire (Temp),
' exécution du filtre et déplacement vers la plage d'origine
With Plage
Set Temp = .Worksheet.Cells(.SpecialCells(xlCellTypeLastCell). _
Row + 1, 1).Resize(.Rows.Count, .Columns.Count)
'.AdvancedFilter Action:=xlFilterInPlace, Unique:=True
.AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Temp, Unique:=True
End With
Temp.Cut Plage
' Traitement des lignes libérées en fonction de 'Modif'
If Modif And WorksheetFunction.CountBlank(Temp) > 0 Then
With Range(Temp.End(xlDown)(2), Temp(Temp.Count))
If Modif = 1 Then .Delete xlShiftUp Else .EntireRow.Delete
End With
End If
' Réinitialisation du UsedRange
Temp.Parent.UsedRange
Fin:
SupprDoublons = Err
If MiseAJourEcran Then Application.ScreenUpdating = True
If Recalcul Then Application.Calculation = xlCalculationAutomatic
End Function
Sub Unique_Efface()
SupprDoublons Selection
End Sub
Sub Unique_SupprPartielle()
SupprDoublons Selection, 1
End Sub
Sub Unique2_SupprEntière()
SupprDoublons Selection, 2
End Sub
'______________________________________________________________________
'La fonction 'SupprDoublons' repose sur l'uilisation d'un filtre
'élaboré avec extraction sans doublon. Une plage temporaire (Temp)
'située en-dessous de la dernière cellule utilisée dans la feuille
'de calcul reçoit les données construites par le filtre, et son
'contenu est recopié dans un deuxième temps à l'emplacement de la
'plage d'origine.
met en commentaire cette commande : ' Temp.Cut Plage pour empecher qu'elle ne s'exécute.
isabelle
Bonjour,
Etant débutant en VBA, j'ai récupéré une macro permettant de gérer les doublons dont une personne faisait allusion sur un précédent post, macro récupéré sur le site de Laurent Longre. En théorie, elle permet de supprimer des doublons dans un tableau excel, mais également les effacer sans les supprimer. C'est cette fonctionnalité qui m'intéresse : j'aimerais juste effacer les lignes des doublons sans les supprimer de manière à pouvoir faire des calculs de statistiques sur un autre onglet. En supprimant les lignes, les références me permettant de calculer mes statistiques ne fonctionnent plus...Mais en utilisant la macro d'effacement des lignes, ca ne fonctionne pas... J'ai un bouton sur ma feuille où figure le tableau avec les doublons, ce bouton lance la macro Unique_Efface mais celle-ci supprime les doublons...Je dois mal utiliser cette macro. Ci-dessous figure le code de toute la macro. __________________
Function SupprDoublons(Plage As Range, Optional Modif As Integer) As Long
Dim Temp As Range Dim MiseAJourEcran As Boolean, Recalcul As Boolean
'On Error GoTo Fin
' Sauvegarde des paramètres actuels d'affichage et de recalcul ' If Application.ScreenUpdating Then ' MiseAJourEcran = True ' Application.ScreenUpdating = False ' End If ' If Application.Calculation = xlCalculationAutomatic Then ' Recalcul = True ' Application.Calculation = xlCalculationManual ' End If
' Détermination de la plage d'extraction temporaire (Temp), ' exécution du filtre et déplacement vers la plage d'origine With Plage Set Temp = .Worksheet.Cells(.SpecialCells(xlCellTypeLastCell). _ Row + 1, 1).Resize(.Rows.Count, .Columns.Count) '.AdvancedFilter Action:=xlFilterInPlace, Unique:=True .AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Temp, Unique:=True End With Temp.Cut Plage
' Traitement des lignes libérées en fonction de 'Modif' If Modif And WorksheetFunction.CountBlank(Temp) > 0 Then With Range(Temp.End(xlDown)(2), Temp(Temp.Count)) If Modif = 1 Then .Delete xlShiftUp Else .EntireRow.Delete End With End If
' Réinitialisation du UsedRange Temp.Parent.UsedRange
Fin: SupprDoublons = Err If MiseAJourEcran Then Application.ScreenUpdating = True If Recalcul Then Application.Calculation = xlCalculationAutomatic
End Function
Sub Unique_Efface() SupprDoublons Selection End Sub
Sub Unique_SupprPartielle() SupprDoublons Selection, 1 End Sub
Sub Unique2_SupprEntière() SupprDoublons Selection, 2 End Sub '______________________________________________________________________
'La fonction 'SupprDoublons' repose sur l'uilisation d'un filtre 'élaboré avec extraction sans doublon. Une plage temporaire (Temp) 'située en-dessous de la dernière cellule utilisée dans la feuille 'de calcul reçoit les données construites par le filtre, et son 'contenu est recopié dans un deuxième temps à l'emplacement de la 'plage d'origine.
