christine854
XLDnaute Junior
bonjour a tous
j'ai une macro que je souhaite adapter pour un fichier
j'ai commencé a l'adapté mais je coince sur certains point
voici la macro
Option Explicit
Dim tablo, fb As Worksheet, ft As Worksheet, cell As Range, dte As Date, i&
Sub CONDITION ()
'on defini les variables
Dim Valeur_Test As String
Dim DerniereLigne As Integer
Dim Lig
Set ft = Sheets("TEST_VALIDATION")
Set fb = Sheets("STOCKAGE_DES_DONNEES")
'pour une lecture plus rapide des données dans le tableau résultat
tablo = ft.Range("Q2:Y" & ft.Range("Q" & Rows.Count).End(xlUp).Row)
For i = 2 To UBound(tablo, 1)
Set cell = fb.Range("A2:A" & fb.Range("A" & Rows.Count).End(xlUp).Row).Find(tablo(i, 1), LookAt:=xlWhole)
If Not cell Is Nothing Then
If IsDate(cell.Offset(0, 1)) Then
'Si le test est ok alors on test la Premières condition
If tablo(i, 25) = "L" Or "J" _
And Month(cell.Offset(0, 1)) = Month(Date) _
And Year(cell.Offset(0, 1)) = Year(Date) Then
fb.Range("C" & cell.Row & ":H" & cell.Row).Delete shift:=xlUp
cell.Offset(0, 1) = DateSerial(Year(cell.Offset(0, 1)), Month(cell.Offset(0, 1)) + 5, 1)
'puis la Deuxièmes conditions
ElseIf tablo(i, 25) = "K" And Month(cell.Offset(0, 1)) = Month(Date) _
And Year(cell.Offset(0, 1)) = Year(Date) Then
ft.Range("Q" & i & ":Y" & i).Copy ft.Range("AD" & i)
cell.Offset(0, 1) = "cumule " & cell.Offset(0, 1)
End If
'puis la Troisièmes conditions
ElseIf tablo(i, 19) > 80 And cell.Offset(0, 1) Like "cumule*" Then
fb.Range("C" & cell.Row & ":H" & cell.Row).Delete shift:=xlUp
cell.Offset(0, 1) = DateSerial(Year(Date), Month(Date) + 5, 1)
End If
'on test si l'identifiant existe Sinon, on l'ajoute à la liste avec la date de fin
Else
Cells(DerniereLigne + 1, 1).Value = Valeur_Test
End If
Next i
End Sub
je coince sur : (j'ai mis des commentaire a coté des ligne ou je coince)
For i = 2 To UBound(tablo, 1)
Set cell = fb.Range("A2:A" & fb.Range("A" & Rows.Count).End(xlUp).Row).Find(tablo(i, 1), LookAt:=xlWhole)
If Not cell Is Nothing Then
If IsDate(cell.Offset(0, 1)) Then
If tablo(i, 25) = "L" Or "J" _
And Month(cell.Offset(0, 1)) = Month(Date) _ 'doit tester dans la feuille fb
And Year(cell.Offset(0, 1)) = Year(Date) Then
fb.Range("C" & cell.Row & ":H" & cell.Row).Delete shift:=xlUp
cell.Offset(0, 1) = DateSerial(Year(cell.Offset(0, 1)), Month(cell.Offset(0, 1)) + 5, 1) 'doit saisir dans la feuille fb
ElseIf tablo(i, 25) = "K" And Month(cell.Offset(0, 1)) = Month(Date) _
And Year(cell.Offset(0, 1)) = Year(Date) Then 'la date est dans la feuille fb
ft.Range("Q" & i & ":Y" & i).Copy ft.Range("AD" & i)
cell.Offset(0, 1) = "cumule " & cell.Offset(0, 1) 'doit être saisie dans la feuille fb
ElseIf tablo(i, 19) > 80 And cell.Offset(0, 1) Like "cumule*" Then 'cumule est dans la feuille fb
fb.Range("C" & cell.Row & ":H" & cell.Row).Delete shift:=xlUp
cell.Offset(0, 1) = DateSerial(Year(Date), Month(Date) + 5, 1) 'saisie de la date dans la feuille fb
la ou j'ai mis des commentaires c'est là ou j'ai mes données mais je ne suis pas sur que dans les conditions ça correspond bien
j'ai une macro que je souhaite adapter pour un fichier
j'ai commencé a l'adapté mais je coince sur certains point
voici la macro
Option Explicit
Dim tablo, fb As Worksheet, ft As Worksheet, cell As Range, dte As Date, i&
Sub CONDITION ()
'on defini les variables
Dim Valeur_Test As String
Dim DerniereLigne As Integer
Dim Lig
Set ft = Sheets("TEST_VALIDATION")
Set fb = Sheets("STOCKAGE_DES_DONNEES")
'pour une lecture plus rapide des données dans le tableau résultat
tablo = ft.Range("Q2:Y" & ft.Range("Q" & Rows.Count).End(xlUp).Row)
For i = 2 To UBound(tablo, 1)
Set cell = fb.Range("A2:A" & fb.Range("A" & Rows.Count).End(xlUp).Row).Find(tablo(i, 1), LookAt:=xlWhole)
If Not cell Is Nothing Then
If IsDate(cell.Offset(0, 1)) Then
'Si le test est ok alors on test la Premières condition
If tablo(i, 25) = "L" Or "J" _
And Month(cell.Offset(0, 1)) = Month(Date) _
And Year(cell.Offset(0, 1)) = Year(Date) Then
fb.Range("C" & cell.Row & ":H" & cell.Row).Delete shift:=xlUp
cell.Offset(0, 1) = DateSerial(Year(cell.Offset(0, 1)), Month(cell.Offset(0, 1)) + 5, 1)
'puis la Deuxièmes conditions
ElseIf tablo(i, 25) = "K" And Month(cell.Offset(0, 1)) = Month(Date) _
And Year(cell.Offset(0, 1)) = Year(Date) Then
ft.Range("Q" & i & ":Y" & i).Copy ft.Range("AD" & i)
cell.Offset(0, 1) = "cumule " & cell.Offset(0, 1)
End If
'puis la Troisièmes conditions
ElseIf tablo(i, 19) > 80 And cell.Offset(0, 1) Like "cumule*" Then
fb.Range("C" & cell.Row & ":H" & cell.Row).Delete shift:=xlUp
cell.Offset(0, 1) = DateSerial(Year(Date), Month(Date) + 5, 1)
End If
'on test si l'identifiant existe Sinon, on l'ajoute à la liste avec la date de fin
Else
Cells(DerniereLigne + 1, 1).Value = Valeur_Test
End If
Next i
End Sub
je coince sur : (j'ai mis des commentaire a coté des ligne ou je coince)
For i = 2 To UBound(tablo, 1)
Set cell = fb.Range("A2:A" & fb.Range("A" & Rows.Count).End(xlUp).Row).Find(tablo(i, 1), LookAt:=xlWhole)
If Not cell Is Nothing Then
If IsDate(cell.Offset(0, 1)) Then
If tablo(i, 25) = "L" Or "J" _
And Month(cell.Offset(0, 1)) = Month(Date) _ 'doit tester dans la feuille fb
And Year(cell.Offset(0, 1)) = Year(Date) Then
fb.Range("C" & cell.Row & ":H" & cell.Row).Delete shift:=xlUp
cell.Offset(0, 1) = DateSerial(Year(cell.Offset(0, 1)), Month(cell.Offset(0, 1)) + 5, 1) 'doit saisir dans la feuille fb
ElseIf tablo(i, 25) = "K" And Month(cell.Offset(0, 1)) = Month(Date) _
And Year(cell.Offset(0, 1)) = Year(Date) Then 'la date est dans la feuille fb
ft.Range("Q" & i & ":Y" & i).Copy ft.Range("AD" & i)
cell.Offset(0, 1) = "cumule " & cell.Offset(0, 1) 'doit être saisie dans la feuille fb
ElseIf tablo(i, 19) > 80 And cell.Offset(0, 1) Like "cumule*" Then 'cumule est dans la feuille fb
fb.Range("C" & cell.Row & ":H" & cell.Row).Delete shift:=xlUp
cell.Offset(0, 1) = DateSerial(Year(Date), Month(Date) + 5, 1) 'saisie de la date dans la feuille fb
la ou j'ai mis des commentaires c'est là ou j'ai mes données mais je ne suis pas sur que dans les conditions ça correspond bien