Insertion de ligne sur des dates
Bonjour à tous,
Je me bats avec une insertion de ligne par année quand on saisit une date de début et une date de fin sur une ligne qui n'ont pas la même année.
Le bug sur le fichier initial était sur la fonction datediff (avec ou sans ") parce que, selon moi, il y a des lignes sans différence d'années.
If DateDiff("yyyy", datA, datB) > 1 Then Mais en créant un fichier test pour la demande, il bug là :
Sub Macro6()
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, datA As Variant, datB As Variant
Dim drn3%
Set ws3 = Sheets("Jobs")
'derniere ligne
drn3 = ws3.Range("A2").End(xlDown).Row
For k = 2 To drn3
datA = ws3.Range("E" & k).Value 'date debut
datB = ws3.Range("F" & k).Value 'date fin
'recopie des années intermédiaires apres insertion ligne
If DateDiff("yyyy", datA, datB) > 1 Then
'changt date fin derniere ligne pour le 31/12
ws3.Range("F" & k).Value = DateSerial(Year(datA) + 1, 12, 31)
For n = k To k + m
Rows(n).EntireRow.Insert
ws3.Range("A" & n).Value = ws3.Range("A" & k + n).Value
ws3.Range("B" & n).Value = ws3.Range("B" & k + n).Value
ws3.Range("C" & n).Value = ws3.Range("C" & k + n).Value
ws3.Range("D" & n).Value = ws3.Range("D" & k + n).Value
ws3.Range("E" & n).Value = DateSerial(Year(datA) + 1, 1, 1)
ws3.Range("F" & n).Value = DateSerial(Year(datA) + 1, 12, 31) '31/12/n+1
Next n
'changt date fin 1ére ligne pour la date de fin
ws3.Range("F" & n).Value = datB
End If
k = 0
Next k
End SubMais finallement j'ai un meulleur résultat avec year(date)
Sub Macro6()
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim drn3%
Set ws3 = Sheets("Jobs")
'derniere ligne
drn3 = ws3.Range("A9").End(xlDown).Row
For k = 2 To drn3
datA = ws3.Range("E" & k).Value 'date debut
datB = ws3.Range("F" & k).Value 'date fin
'recopie des années intermédiaires apres insertion ligne
On Error Resume Next
If Year(datB) - Year(datA) > 1 Then
If k > 1 And k < 10 Then MsgBox Year(datB) - Year(datA)
'changt date fin 1ére ligne pour la date de fin
ws3.Range("F" & k).Value = datB
m = Year(datB) - Year(datA) '2000-1997-1 = 2
For n = 0 To m
Rows(k + n).EntireRow.Insert
ws3.Range("A" & k + n).Value = ws3.Range("A" & k + m).Value
ws3.Range("B" & k + n).Value = ws3.Range("B" & k + m).Value
ws3.Range("C" & k + n).Value = ws3.Range("C" & k + m).Value
ws3.Range("D" & k + n).Value = ws3.Range("D" & k + m).Value
ws3.Range("E" & k + n).Value = DateSerial(Year(datA) + 1, 1, 1) 'ws3.Range("E" & k + 1).Value '01/01/n+1
ws3.Range("F" & k + n).Value = DateSerial(Year(datA) + 1, 12, 31) '31/12/n+1
Next n
'changt date fin derniere ligne pour le 31/12
ws3.Range("F" & k + n).Value = DateSerial(Year(datA) + 1, 12, 31)
End If
Next k
End SubMerci de votre aide.
Bonjour fronck,
un essai ... testé bien sûr ..
Sub Macro6()
Dim ws3 As Worksheet, datA As Date, datB As Date
Dim drn3%
Set ws3 = Sheets("Socs")
'derniere ligne
drn3 = ws3.Range("A2").End(xlDown).Row
For k = 2 To drn3
datA = ws3.Range("D2").Value 'date debut
datB = ws3.Range("E2").Value 'date fin
'recopie des années intermédiaires apres insertion ligne
If Year(datB) - Year(datA) > 1 Then
'changt date fin derniere ligne pour le 31/12
ws3.Range("E" & k).Value = DateSerial(Year(datA) + 1, 12, 31)
For n = k To k + m
Rows(2).EntireRow.Insert
ws3.Range("A" & n).Value = ws3.Range("A" & k + n).Value
ws3.Range("B" & n).Value = ws3.Range("B" & k + n).Value
ws3.Range("C" & n).Value = ws3.Range("C" & k + n).Value
ws3.Range("D" & n).Value = DateSerial(Year(datA) + 1, 1, 1)
ws3.Range("E" & n).Value = DateSerial(Year(datA) + 1, 12, 31) '31/12/n+1
Next n
'changt date fin 1ére ligne pour la date de fin
ws3.Range("E" & n - 1).Value = datB
Else
Exit Sub
End If
k = k - 1
Next k
End Subric
Bonjour ric,
Merci pour ton aide.
Par contre çà me donne çà comme résultat ton code :
et, en supposant que j'ai plus de 3 lignes, je ne suis pas trop ok avec
Rows(2).EntireRow.InsertMais je viens d'y arriver après pas mal de galére pour comprendre comment fonctionne l'insertion de lignes.
Avec plus de lignes dans le tableau et une colonne C en plus, voilà le code.
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim drn3%
Set ws3 = Sheets("Socs")
'derniere ligne
drn3 = ws3.Range("A9").End(xlDown).Row
For k = 2 To drn3
datA = ws3.Range("E" & k).Value 'date debut
datB = ws3.Range("F" & k).Value 'date fin
'recopie des années intermédiaires apres insertion ligne
On Error Resume Next
If Year(datB) - Year(datA) > 1 Then
m = Year(datB) - Year(datA) '2000-1997-1 = 2
For n = 0 To m - 1
Rows(k + n).EntireRow.Insert
ws3.Range("A" & k + n).Value = ws3.Range("A" & k + n + 1).Value
ws3.Range("B" & k + n).Value = ws3.Range("B" & k + n + 1).Value
ws3.Range("C" & k + n).Value = ws3.Range("C" & k + n + 1).Value
ws3.Range("D" & k + n).Value = ws3.Range("D" & k + n + 1).Value
ws3.Range("E" & k + n).Value = DateSerial(Year(datA) + n + 1, 1, 1)
ws3.Range("F" & k + n).Value = DateSerial(Year(datA) + n + 1, 12, 31)
Next n
'changt date fin 1ére ligne pour la date de fin
ws3.Range("F" & k + n - 1).Value = datB
'changt date fin derniere ligne pour le 31/12
ws3.Range("F" & k + n).Value = DateSerial(Year(datA), 12, 31)
End If
Next kçà me donne çà
Il me reste plus qu'un tri pour mettre les lignes dans le bon ordre.
Merci
Bonjour fronk,
Hier, je n’avais pas bien compris ta demande ... ton dernier exemple est plus explicite ...
Je te propose une version dont le code est dans un module et qu’il utilise les références au tableau structuré ...
Sans parler des dates ... l’apparence finale est tributaire des propriétés du tableau au départ ...
Basé sur ton fichier d’hier à 14:45 ...
ric
Bonjour ric,
Nickel, en plus pas besoin de tri. Y'a juste 3 lignes vides aprés le titre, pour chipoter
Merci
Bonjour fronck,
Je viens de tester à nouveau ...
Sur le fichier V4 que j’ai soumis ... je n’ai pas ces lignes vides ...
Puis-je avoir une copie de ton fichier de travail pour comprendre ce qui se passe ?
Au besoin, tu peux me faire parvenir le fichier via message privé ...
ric