Supprimer ligne tableau par rapport un autre

Bonsoir,

Je voudrais soit supprimer ou avoir un autre tableau certaines lignes tu tableau Tb par rapport à un autre tableau créer par code.

le tableau est ainsi: Tb(i,1)=famille - Tb(i,2)=string - Tb(i,3)=date (ex:12/08/2014)

le tableau Tdate: Tdate(j,1)=famille - Tdate(j,2)=Année

Je voudrais exclure de Tb la famille dont l'année de la date est inférieure à l'année du tableau Tdate.

Je ne maitrise pas bien les arrays, mon code plante sur la ligne avec ***

Option Explicit

Sub Macro2()
    Dim L As Integer, i As Integer, j As Integer, c As Long, k As Long
    Dim Tb(), TbR()
    Dim TDate(1 To 8, 1 To 2)
    Dim Bd As Worksheet

    'Tableau date d'acquisition
    TDate(1, 1) = "T1": TDate(1, 2) = "1960"
    TDate(2, 1) = "H2": TDate(2, 2) = "1960"
    TDate(3, 1) = "O1": TDate(3, 2) = "1982"
    TDate(4, 1) = "G1": TDate(4, 2) = "1986"
    TDate(5, 1) = "L1": TDate(5, 2) = "1996"
    TDate(6, 1) = "G2": TDate(6, 2) = "2000"
    TDate(7, 1) = "DL1": TDate(7, 2) = "2004"
    TDate(8, 1) = "RO1": TDate(8, 2) = "2006"
    ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    Set Bd = Sheets("bd")
    L = Bd.Range("A" & Rows.Count).End(xlUp).Row
    Tb = Bd.Range("A2:C" & L).Value
    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
    ReDim TbR(1 To UBound(Tb), 1 To 3)
    For i = 1 To UBound(Tb)
        For j = 1 To 8
            c = c + 1
            If Tb(i, 1) = TDate(j, 1) And Year(Tb(i, 3)) < TDate(j, 2) Then
                TbR(c, 1) = Tb(i, 1) '*** n'appartient pas à la selection
                TbR(c, 2) = Tb(i, 2)
                TbR(c, 3) = Tb(i, 3)
            End If
        Next j
    Next i

    Bd.[I2].Resize(UBound(TbR), 3) = TbR 'pour pouvoir confirmer bon résultat
End Sub

En vous remerciant par avance

19oterlignes.xlsm (17.82 Ko)

Bonsoir

A vérifier

Sub Macro2()
Dim L As Integer, i As Integer, j As Integer, c As Long, k As Long
Dim Tb(), TbR()
Dim TDate(1 To 8, 1 To 2)
Dim Bd As Worksheet

  'Tableau date d'acquisition    
  TDate(1, 1) = "T1": TDate(1, 2) = 1960
  TDate(2, 1) = "H2": TDate(2, 2) = 1960
  TDate(3, 1) = "O1": TDate(3, 2) = 1982
  TDate(4, 1) = "G1": TDate(4, 2) = 1986
  TDate(5, 1) = "L1": TDate(5, 2) = 1996
  TDate(6, 1) = "G2": TDate(6, 2) = 2000
  TDate(7, 1) = "DL1": TDate(7, 2) = 2004
  TDate(8, 1) = "RO1": TDate(8, 2) = 2006
  ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  Set Bd = Sheets("bd")
  L = Bd.Range("A" & Rows.Count).End(xlUp).Row
  Tb = Bd.Range("A2:C" & L).Value
  '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
  ReDim TbR(1 To UBound(Tb), 1 To 3)
  For i = 1 To UBound(Tb)
    For j = 1 To 8
      'c = c + 1
      If Tb(i, 1) = TDate(j, 1) And Year(Tb(i, 3)) < TDate(j, 2) Then
        c = c + 1
        TbR(c, 1) = Tb(i, 1)
        TbR(c, 2) = Tb(i, 2)
        TbR(c, 3) = Tb(i, 3)
        Exit For
      End If
    Next j
  Next i

  Bd.[I2].Resize(UBound(TbR), 3) = TbR   'pour pouvoir confirmer bon résultat
End Sub

Bonjour Banzai64,

Je te remercie beaucoup de m'avoir corrigé le code. J'ai certainement omis quelque chose plus que le résultat retourné n'est pas exactement le résultat attendu.

En effet sur les 105 lignes du tableau Tb, il n'en doit rester que 88 (17 doivent disparaitre). Dans le code on vérifie TbR(c,1)=Tb(i,1) représentant la famille et Year(TbR(c,3)<Tb(i,2) représentant l'année. Or le résultat obtenu, ne respecte pas ces conditions. Il y a sûrement quelque chose qui m'échappe d'autant plus que les 2 lignes qui devait être supprimées, sont renvoyées dans le résultat (famille RO1, lignes en rouge sur le fichier).

edit: le résultat est bon avec ceci Year(TbR(c,3)>=Tb(i,2)

Encore merci et bonne journée.

Rechercher des sujets similaires à "supprimer ligne tableau rapport"