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 SubEn vous remerciant par avance
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 SubBonjour 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.