Doublon difficulté pour supprimer des portions de lignes

Goufra

XLDnaute Occasionnel
Bonsoir à vous,
Je viens encore puiser dans votre savoir !

J’ai un problème de suppression de portion de ligne contenant des doublons dans un tableau.

Mon code fonctionne pour le tableau « a12 : C22 »

Il s’agit de supprimer les portions de ligne de la col A à B contenant des doublons situés dans la colonne B

Les cellules de la colonne C restent intactes.

Le tableau a été préalablement trié par rapport à la colonne B

Sub supdoublon()
Dim i As Integer
For i = [b65000].End(xlUp).Row To 11 Step -1
If Cells(i, 2) = Cells(i - 1, 2) Then
Cells(i, 1).Resize(1, 2).Delete shift:=xlUp
End If
Next i
End Sub



J’ai essayé d’écrire, par analogie, un code pour traiter les doublons d’un tableau qui se trouve à l’extérieure de la colonne A
Tableau E12 à G22 par exemple.

Supprimer pour chaque doublon de la colonne F la portion de ligne de la col E à la col F. Je n’y arrive pas !!!!

J’ai cherché mais je n’ai rien trouvé de simple !

Je patine …
D ‘avance, merci pour votre aide.
 

Pièces jointes

  • goufra.xls
    32.5 KB · Affichages: 62
  • goufra.xls
    32.5 KB · Affichages: 74
  • goufra.xls
    32.5 KB · Affichages: 72

soenda

XLDnaute Accro
Re : Doublon difficulté pour supprimer des portions de lignes

Bonsoir le fil, Goufra

Vois si le code suivant, convient
Code:
Sub b()
 
    [H12].Formula = "=(B12=F12)+(B12=B11)"
 
    With [H12:H22]
 
        [H12].AutoFill .Offset
        .Value = .Value
 
        Intersect(.ColumnDifferences([H12]).EntireRow, ([A:B, E:G])).Delete xlUp
 
        .ClearContents
 
    End With
 
End Sub
A plus
 

Goufra

XLDnaute Occasionnel
Re : Doublon difficulté pour supprimer des portions de lignes

Bonsoir et merci Soenda,

J'ai copié ton code il agit sur le tableau a12:c22. Mon code aussi.

Mon problème c'est le tableau E12:G22. Dans la réalité il est tout seul dans une feuille. Je souhaite trouver le code pour supprimer les doublons et le segment de ligne de E à F contenant ces doublons.

Je te remercie par avance.
Bonsoir Xldien insomniaque.
 

soenda

XLDnaute Accro
Re : Doublon difficulté pour supprimer des portions de lignes

Re,

Deuxième essai ...
Code:
Sub b()
 
    [H12].Formula = "=IF(COUNTIF(E$12:E$22,E12)-1,1,"""")"
    [H12].AutoFill [H12:H22]
 
    With [H11:H22]
        .Value = .Value
        Intersect(.ColumnDifferences([H11]).EntireRow, ([E:G])).Delete xlUp
        .ClearContents
    End With
 
End Sub
A plus
 

Goufra

XLDnaute Occasionnel
Re : Doublon difficulté pour supprimer des portions de lignes

bonjour soenda et merci à toi,
Mes yeux se croisaient il était préférable que je parte me coucher !

Navré mais le dernier code que tu m'adresses n'est pas enore au point, il supprime tout le tableau.
Une façon comme une autre de supprimer le problème .... bref je continue à chercher.

à bientôt ... peut-être
je t'adresse mes cordialités xldiennes.
 

kjin

XLDnaute Barbatruc
Re : Doublon difficulté pour supprimer des portions de lignes

Bonjour,
Comprends pas ton pb
Si ton tableau commence colonne E et tes doublons sont en colonne F
Code:
Sub supdoublon()
Dim i As Integer
  For i = [[COLOR="Red"]F65000[/COLOR]].End(xlUp).Row To 11 Step -1
    If Cells(i, [COLOR="Red"]6[/COLOR]) = Cells(i - 1, [COLOR="Red"]6[/COLOR]) Then
      Cells(i, [COLOR="Red"]5[/COLOR]).Resize(1, 2).Delete shift:=xlUp
    End If
  Next i
End Sub
A+
kjin
 

Goufra

XLDnaute Occasionnel
Re : Doublon difficulté pour supprimer des portions de lignes

Bonsoir Kjin,

Merci, bien evidemment cela fonctionne. Mon problème, se situait dans l'incompréhension de l'utilisation de resize.

Si je pouvais abuser :
Dans If Cells(i, 6) = Cells(i - 1, 6) Then Cells(i, 5), je peux utiliser des variables x et y qui valent respectivement 6 et 5 ds l'exemple.

Pour ce qui concerne F65000 est-il possible d'utiliser une variable en son lieu et place ?
J'ai essayé, j'obtiens " erreur de qualification" avec [var].end ... ou de compilation avec (var).end ....

Je te remercie par avance
Cordialement
 

Bebere

XLDnaute Barbatruc
Re : Doublon difficulté pour supprimer des portions de lignes

bonjour Goufra,Kjin,Soenda
essaye ce code

Sub supdoublon()
Dim i As Integer, L As Long, Tbl

Application.ScreenUpdating = False

Tbl = Array(1, 5)
For L = 0 To UBound(Tbl)
For i = Cells(65000, Tbl(L)).End(xlUp).Row To 12 Step -1
If Cells(i, Tbl(L) + 1) = Cells(i - 1, Tbl(L) + 1) Then
Cells(i, Tbl(L)).Resize(1, 2).Delete shift:=xlUp
End If
Next i
Next L

Application.ScreenUpdating = True

End Sub

à bientôt
 

Goufra

XLDnaute Occasionnel
Re : Doublon difficulté pour supprimer des portions de lignes

Bonsoir bebere

Je te remercie d'avoir pris le temps de m'apporter ton aide.

deux points .

1/Ton code fonctionne. Je pense avoir trouvé un tutoriel pour essayer de comprendre l'écriture et le fonctionnement de ton code.

2/ Ma 2 ème question est mal posée, en fait le code initial explicité par la réponse de Kjin me convient.

Je cherche à utiliser une variable qui me permette de choisir la colonne souhaitée :

une variable pour changer f65000 par P65000 ou M65000 etc ..
dans For i = [f65000].End(xlUp).Row To 11 Step -1

je n'ai pas trouvé la solution.

Merci par avance pour ton aide
Bien cordialement
 

Goufra

XLDnaute Occasionnel
Re : Doublon difficulté pour supprimer des portions de lignes

Rebonsoir,
Autant pour moi j'ai trouvé une solution.

x = 5

For i = Cells(65000, x).End(xlUp).Row To 12 Step -1
If Cells(i, x + 1) = Cells(i - 1, x + 1) Then Cells(i, x).Resize(1, 2).Delete shift:=xlUp

ouf !

Mais pas la réponse aux explications de bebere.
Cordialement
 

Bebere

XLDnaute Barbatruc
Re : Doublon difficulté pour supprimer des portions de lignes

bonsoir
avec une inputbox

Sub supdoublon()
Dim i As Integer, Cel As Range, C As Integer

Application.ScreenUpdating = False
On Error Resume Next
'entrer A1,E1 1ère colonne de la plage
Set Cel = Application.InputBox("Sélection d'une cellule,svp", "Select", , , , , , 8)
If Cel Is Nothing Then Exit Sub
C = Cel.Column
For i = Cells(65000, C).End(xlUp).Row To 12 Step -1
If Cells(i, C + 1) = Cells(i - 1, C + 1) Then
Cells(i, C).Resize(1, 2).Delete shift:=xlUp
End If
Next i

Application.ScreenUpdating = True

End Sub
à bientôt
 

Discussions similaires

Réponses
26
Affichages
1 K
Réponses
22
Affichages
937

Statistiques des forums

Discussions
312 764
Messages
2 091 860
Membres
105 082
dernier inscrit
saragestion