Tableau

[Pasc11q]

Bonjour a tous, j'ai deux tableau et j'aimerais que les numéro en jaune dans le tableau b sois dans une autre colonne ou que les numéro identique des 2 tableau sois effacé. Est ce possible et merci d'avance.

 

[JCGL]

Re : Tableau

Bonjour à tous,

Peux-tu essayer avec ceci ( à finalser car je ne suis pas certain d'avoir compris) :

Option Explicit

Sub Isole()
Dim Lig&, DerL&, C_Lig&
DerL = Feuil1.Range("E" & Rows.Count).End(3).Row

C_Lig = 1
With Feuil1
Range("D3:D" & DerL).FormulaR1C1 = "=IF(RC[1]="""",1,COUNTIF(R3C1:R200C1,RC[1]))"
For Lig = DerL To 3 Step -1
If Cells(Lig, "D") = 0 Then
Range("E" & Lig & ":G" & Lig).Cut Feuil2.Range("A" & C_Lig)
C_Lig = C_Lig + 1
End If
Next
End With
Columns("D:D").Clear
End Sub

A+ à tous

 

[job75]

Re : Tableau

Bonjour Pasc11q, Jean-Claude, le forum,

Il peut y avoir des numéros sans doublon à conserver dans les 2 tableaux :

Private Sub Worksheet_Activate()
Dim P As Range, a$
Application.ScreenUpdating = False
Feuil1.[A:G].Copy [A1] 'Feuil1 est le CodeName de la feuille source
Set P = Me.UsedRange.Offset(2) 'décalage à cause des 2 lignes de titres
'---colonne D pour Tableau A---
With P.Columns(4)
  a = P.Columns(6).Address(ReferenceStyle:=xlR1C1)
  .FormulaR1C1 = "=1/IF(RC2<>"""",COUNTIF(" & a & ",RC2)=0)"
  .Value = .Value 'supprime les formules
  Range("A3", .Cells).Sort .Cells, xlAscending, Header:=xlNo 'tri pour accélérer
End With
'---colonne H pour Tableau B---
With P.Columns(8)
  a = P.Columns(2).Address(ReferenceStyle:=xlR1C1)
  .FormulaR1C1 = "=1/IF(RC6<>"""",COUNTIF(" & a & ",RC6)=0)"
  .Value = .Value 'supprime les formules
  Range("E3", .Cells).Sort .Cells, xlAscending, Header:=xlNo 'tri pour accélérer
End With
'---supprime les valeurs d'erreur (doublons et cellules vides)---
'On Error Resume Next 'inutile puisqu'avec le décalage il y a des cellules vides
Intersect([A:D], [D:D].SpecialCells(xlCellTypeConstants, 16).EntireRow).Delete xlUp
Intersect([E:H], [H:H].SpecialCells(xlCellTypeConstants, 16).EntireRow).Delete xlUp
[D:D,H:H].ClearContents
Set P = Me.UsedRange 'actualise la barre de défilement verticale
End Sub

La macro est dans le code de la 2ème feuille et se déclenche quand on active cette feuille.

Edit : On Error Resume Next est toujours inutile quand il y a des titres.

Fichier joint.

A+

 

[Pasc11q]

Re : Tableau

Merci Job75 pour la réponse

 

[job75]

Re : Tableau

Re,

Merci du merci mais vous oubliez de remercier aussi JCGL qui pourtant le mérite bien

A+

 

[job75]

Re : Tableau

Re,

Pour finir, un code plus "ramassé" :

Private Sub Worksheet_Activate()
Dim P As Range, a$
Application.ScreenUpdating = False
Feuil1.[A:G].Copy [A1] 'Feuil1 est le CodeName de la feuille source
Set P = Me.UsedRange.Offset(2) 'décalage à cause des 2 lignes de titres
'---colonne D pour Tableau A, colonne H pour Tableau B---
For Each P In Union(P.Columns(4), P.Columns(8)).Areas
  a = P.Offset(, IIf(P.Column = 4, 2, -6)).Address(ReferenceStyle:=xlR1C1)
  P.FormulaR1C1 = "=1/IF(RC[-2]<>"""",COUNTIF(" & a & ",RC[-2])=0)"
  P = P.Value 'supprime les formules
  Range(P.Offset(, -3), P).Sort P, xlAscending, Header:=xlNo 'tri pour accélérer
Next
'---supprime les valeurs d'erreur (doublons et cellules vides)---
'On Error Resume Next 'inutile puisqu'avec le décalage il y a des cellules vides
Intersect([A:D], [D:D].SpecialCells(xlCellTypeConstants, 16).EntireRow).Delete xlUp
Intersect([E:H], [H:H].SpecialCells(xlCellTypeConstants, 16).EntireRow).Delete xlUp
[D:D,H:H].ClearContents
Set P = Me.UsedRange 'actualise la barre de défilement verticale
End Sub

Fichier (2).

A+

 

[Pasc11q]

Re : Tableau

Job75 peux tu m'indiquer quoi changer pour que le tri sois fait a partir du scellé

 

[job75]

Re : Tableau

Job75 peux tu m'indiquer quoi changer pour que le tri sois fait a partir du scellé

Je répondrai quand suite aura été donnée à mon post #5, désolé mais j'ai de la suite dans les idées

 

[Pasc11q]

Re : Tableau

Je m'excuse Job 75, je pensais l'avoir fais, je veux aussi remercier JCGL pour son aide.

 

[job75]

Re : Tableau

Bonjour Pasc11q, JC, le forum,

Maintenant cette macro étudie les doublons des colonnes A et E "scelle" :

Private Sub Worksheet_Activate()
Dim P As Range, a$
Application.ScreenUpdating = False
Feuil1.[A:G].Copy [A1] 'Feuil1 est le CodeName de la feuille source
Set P = Me.UsedRange.Offset(2) 'décalage à cause des 2 lignes de titres
'---colonne D pour Tableau A, colonne H pour Tableau B---
For Each P In Union(P.Columns(4), P.Columns(8)).Areas
  a = P.Offset(, IIf(P.Column = 4, 1, -7)).Address(ReferenceStyle:=xlR1C1)
  P.FormulaR1C1 = "=1/IF(RC[-3]<>"""",COUNTIF(" & a & ",RC[-3])=0)"
  P = P.Value 'supprime les formules
  Range(P.Offset(, -3), P).Sort P, xlAscending, Header:=xlNo 'tri pour accélérer
Next
'---supprime les valeurs d'erreur (doublons et cellules vides)---
'On Error Resume Next 'inutile puisqu'avec le décalage il y a des cellules vides
Intersect([A:D], [D:D].SpecialCells(xlCellTypeConstants, 16).EntireRow).Delete xlUp
Intersect([E:H], [H:H].SpecialCells(xlCellTypeConstants, 16).EntireRow).Delete xlUp
[D:D,H:H].ClearContents
Set P = Me.UsedRange 'actualise la barre de défilement verticale
End Sub

J'ai juste modifié les lignes 8 (a) et 9 de la macro.

Fichier (3).

Bonne journée et A+

 

[Pasc11q]

Re : Tableau

Merci a tous et a job 75 pour votre aide cela a été apprécié.Avec les dernière modification j'obtiens une liste rapidement.