doublon sur 2 feuilles

yohinomura · 8 Juillet 2010

Bonjour le forum,
je souhaite mettre a jours une feuille (PrevNL) par rapport a une autre (NL)
mon controle se fait sur la colonne C
j'ai modifié une formule qui marche très bien pour une seule feuille mais pas dans mon cas

formule d'origine:
Doublon = Range("C1000").End(xlUp).Value
If Application.CountIf(Range("C2:C" & Range("C1000").End(xlUp).Row), Doublon) > 1 Then
Range("C1000").End(xlUp).EntireRow.Delete
End If

formule modifiée:
Doublon = Range("NL!C1000").End(xlUp).Value
If Not Application.CountIf(Range("PrevNL!C2:C" & Range("PrevNL!C1000").End(xlUp).Row), Doublon) > 1 Then
Range("PrevNL!C1000").End(xlUp).EntireRow.Delete
End If

tout ce que j'arrive a faire, c'est supprimer la dernière ligne de la feuille PrevNL

dans un premier temps, je veux supprimer la ligne complete de la feuille PrevNL si je ne retrouve pas le numero correspondant de la colonne C dans la feuille NL

😕😕😕

je ne comprend de moins en moins, fait trop chaud.

Merci à vous

yohinomura · 20 Juillet 2010

Re : doublon sur 2 feuilles

Bonjour,

après de nombreux tests, je viens de me rendre compte qu'il y a une erreur quand les tableaux sont vides.

y a-t-il une solution, ormis le pré-remplir ??

Slts

Yo

ROGER2327 · 20 Juillet 2010

Re : doublon sur 2 feuilles

Re...

yohinomura à dit:
Bonjour,

après de nombreux tests, je viens de me rendre compte qu'il y a une erreur quand les tableaux sont vides.

y a-t-il une solution, ormis le pré-remplir ??

Slts

Yo

Le problème vient de ce que lorsque qu'aucun numéro de commande n'est saisi,

Code:

[COLOR="DarkSlateGray"][B]TABLEAU = .Range(.Cells(1, 3), .Cells(.Rows.Count, 3).End(xlUp)).Value[/B][/COLOR]

ne renvoie pas un tableau, mais une simple variable de type String contenant l'intitulé de la colonne.

Solution : sélectionner deux colonnes

Code:

[COLOR="DarkSlateGray"][B]TABLEAU = .Range(.Cells(1, [COLOR="Red"]4[/COLOR]), .Cells(.Rows.Count, 3).End(xlUp)).Value[/B][/COLOR]

puis redimensionner en gardant une seule colonne

Code:

[COLOR="DarkSlateGray"][B]ReDim Preserve TABLEAU(1 To UBound(TABLEAU, 1), 1 To 1)[/B][/COLOR]

S'il n'y a aucun numéro de commande saisi, on obtient un tableau d'une ligne et d'une colonne.

Ce qui donne :

Code:

[COLOR="DarkSlateGray"][B]Sub toto()
Dim i&, j&, tmp, ComNL, ComPrevNL, CollPrevNL As New Collection
   With Sheets("NL")
      ComNL = .Range(.Cells(1, [COLOR="Red"]4[/COLOR]), .Cells(.Rows.Count, [COLOR="Red"]3[/COLOR]).End(xlUp)).Value
   End With
   [COLOR="Red"]ReDim Preserve ComNL(1 To UBound(ComNL, 1), 1 To 1)[/COLOR]
   With Sheets("PrevNL")
      ComPrevNL = .Range(.Cells(1, [COLOR="Red"]4[/COLOR]), .Cells(.Rows.Count, [COLOR="Red"]3[/COLOR]).End(xlUp)).Value
      [COLOR="Red"]ReDim Preserve ComPrevNL(1 To UBound(ComPrevNL, 1), 1 To 1)[/COLOR]
      For i = UBound(ComPrevNL, 1) To 2 Step -1
         tmp = ComPrevNL(i, 1)
         On Error Resume Next
         CollPrevNL.Add tmp, CStr(tmp)
         On Error GoTo 0
         For j = 2 To UBound(ComNL, 1)
            If ComNL(j, 1) = tmp Then Exit For
         Next j
         If j > UBound(ComNL, 1) Then
            .Rows(i).EntireRow.Delete [COLOR="SeaGreen"]'suppression d'un enregistrement obsolète[/COLOR]
         Else
            Sheets("NL").Rows(j).Copy Destination:=.Rows(i).Cells(1, 1) [COLOR="SeaGreen"]'actualisation d'un enregistrement existant[/COLOR]
         End If
      Next i
      j = .Cells(.Rows.Count, 3).End(xlUp).Row
      For i = 2 To UBound(ComNL, 1)
         tmp = ComNL(i, 1)
         On Error GoTo E
         CollPrevNL.Add tmp, CStr(tmp)
         On Error GoTo 0
         j = j + 1
         Sheets("NL").Rows(i).Copy Destination:=.Rows(j).Cells(1, 1) [COLOR="SeaGreen"]'ajout d'un enregistrement[/COLOR]
R:    Next i
   End With
Exit Sub
E:
   On Error GoTo 0
   Resume R
End Sub[/B][/COLOR]

Remarque : Ce code fonctionnera même si vous ne redimensionnez pas les tableaux pour les ramener à une colonne. Cependant, je pense qu'il vaut mieux redimensionner pour alléger les tableaux.

Voilà, c'est à tester...

Bon courage.

ROGER2327
#3930

Samedi 7 Tatane 137 (Saint Biribi, taulier, SQ)
2 Thermidor An CCXVIII
2010-W29-2T08:55:26Z

yohinomura · 20 Juillet 2010

Re : doublon sur 2 feuilles

Encore merci Roger

Pour ne pas être bloqué, j'avais effectué un test sur la cellule A2.

Je test votre solution et vous tien au courant.

Yo

yohinomura · 20 Juillet 2010

Re : doublon sur 2 feuilles

Re Bonjour,

je viens de faire le test complet mais il y a problème:

il n'y a pas de mise a jours des cellules A à L mais le remplacement de la ligne compltète et mes données ce trouvant su cette même ligne après H sont supprimées.

Sheets("NL").Rows(j).Copy Destination:=.Rows(i).Cells(1, 1)
je peux remplacer une partie par:
Sheets("NL").Range("A" & j ": L" & j).Copy Destination:=.Rows(i).Cells(1, 1)
mais après = je vois pas

yohinomura · 20 Juillet 2010

Re : doublon sur 2 feuilles

Sheets("NL").Range("A" & j, "L" & j).Copy Destination:=.Range("A" & i)

je crois que ça marche

je test

ROGER2327 · 20 Juillet 2010

Re : doublon sur 2 feuilles

Re...

Il m'a échappé ceci

3° si il existe dans les 2 feuilles, il faut copier la selection A(n):L(n) de NL sur PrevNL (sorte de mise à jours).

dans le message #8, et j'ai traité des lignes entières.

Voyez si

Code:

[COLOR="DarkSlateGray"][B]Sub toto()
Dim i&, j&, tmp, ComNL, ComPrevNL, CollPrevNL As New Collection
   With Sheets("NL")
      ComNL = .Range(.Cells(1, 4), .Cells(.Rows.Count, 3).End(xlUp)).Value
   End With
   ReDim Preserve ComNL(1 To UBound(ComNL, 1), 1 To 1)
   With Sheets("PrevNL")
      ComPrevNL = .Range(.Cells(1, 4), .Cells(.Rows.Count, 3).End(xlUp)).Value
      ReDim Preserve ComPrevNL(1 To UBound(ComPrevNL, 1), 1 To 1)
      For i = UBound(ComPrevNL, 1) To 2 Step -1
         tmp = ComPrevNL(i, 1)
         On Error Resume Next
         CollPrevNL.Add tmp, CStr(tmp)
         On Error GoTo 0
         For j = 2 To UBound(ComNL, 1)
            If ComNL(j, 1) = tmp Then Exit For
         Next j
         If j > UBound(ComNL, 1) Then
            .Rows(i).EntireRow.Delete 'suppression d'un enregistrement obsolète
         Else
            Sheets("NL").Rows(j)[COLOR="Red"].Resize(1, 12)[/COLOR].Copy Destination:=.Rows(i).Cells(1, 1) 'actualisation d'un enregistrement existant
         End If
      Next i
      j = .Cells(.Rows.Count, 3).End(xlUp).Row
      For i = 2 To UBound(ComNL, 1)
         tmp = ComNL(i, 1)
         On Error GoTo E
         CollPrevNL.Add tmp, CStr(tmp)
         On Error GoTo 0
         j = j + 1
         Sheets("NL").Rows(i)[COLOR="Red"].Resize(1, 12)[/COLOR].Copy Destination:=.Rows(j).Cells(1, 1) 'ajout d'un enregistrement
R:    Next i
   End With
Exit Sub
E:
   On Error GoTo 0
   Resume R
End Sub[/B][/COLOR]

est convenable. (Je crois que oui.)

ROGER2327
#3936

Samedi 7 Tatane 137 (Saint Biribi, taulier, SQ)
2 Thermidor An CCXVIII
2010-W29-2T13:26:50Z

yohinomura · 20 Juillet 2010

Re : doublon sur 2 feuilles

Merci Roger

Je test ça mais plus aujourd'hui, j'ai la tête qui va exploser.
je posterais le résultat des tests demain

bonne après-midi à vous

yohinomura · 21 Juillet 2010

Re : doublon sur 2 feuilles

Bonjour

le test a été effectué avec succés

je vous remercie pour tout

Yo

doublon sur 2 feuilles

yohinomura

Guest

Pièces jointes

yohinomura

Guest

ROGER2327

XLDnaute Barbatruc

yohinomura

Guest

yohinomura

Guest

yohinomura

Guest

ROGER2327

XLDnaute Barbatruc

yohinomura

Guest

yohinomura

Guest

Discussions similaires

doublon sur 2 feuilles

yohinomura

Guest

Pièces jointes

yohinomura

Guest

ROGER2327

XLDnaute Barbatruc

yohinomura

Guest

yohinomura

Guest

yohinomura

Guest

ROGER2327

XLDnaute Barbatruc

yohinomura

Guest

yohinomura

Guest

Discussions similaires

Privacy & Transparency

Privacy & Transparency