Insertion automatique d'une colonne des dates manquantes

sandra131313 · 24 Novembre 2016

Bonjour,

Je suis actuellement sur un fichier où sont répertoriées des dates dans la colonne A et il faudrait que je puisse avoir une insertion dans la colonne B des dates manquantes de la colonne A. On ne regarde pas si ce sont des jours ouvrés ou pas, on va au plus simple.

Le truc, c'est que même avec des forums, je suis perdue dans le process VB / VBA (les codes qu'il faut faire pour obtenir ce que je veux). Je suis plus que novice dans ce domaine. Je ne sais même pas où il faut aller à part dans l'onglet Développeur... Ca craint...

Je vous joins mon fichier, en croisant les doigts de trouver une bonne âme qui saurait faire cela, s'il vous plaît ?

Merci infiniment, car sinon, je dois tout taper à la main... J'ai pas fini...

klin89 · 24 Novembre 2016

Bonsoir sandra131313

A tester sur quelques dates

VB:

Option Explicit
Sub test()
Dim a, debut As Date, fin As Date, i As Long, n As Long, e, y
    'Application.ScreenUpdating = False
    With Sheets(1)
        a = .Range("a2", .Range("a" & Rows.Count).End(xlUp)).Value
        debut = Int(.Range("a2").Value)
        fin = Int(.Range("a" & Rows.Count).End(xlUp).Value)
    End With
    With CreateObject("Scripting.Dictionary")
        For i = debut To fin
            .Item(i) = Empty
        Next
        For i = 2 To UBound(a, 1)
            If .exists(Int(a(i, 1))) Then
                .Item(Int(a(i, 1))) = True
            End If
        Next
        For Each e In .keys
            If Not IsEmpty(.Item(e)) Then .Remove e
        Next
        n = .Count: y = .keys
        If n Then
            With Sheets(1).Range("c1").Resize(n, 1)
                .NumberFormat = "m/d/yyyy"
                .FormulaLocal = Application.Transpose(y)
            End With
        End If
    End With
    'Application.ScreenUpdating = True
End Sub

klin89

sandra131313 · 24 Novembre 2016

klin89 à dit:
Option Explicit
Sub test()
Dim a, debut As Date, fin As Date, i As Long, n As Long, e, y
'Application.ScreenUpdating = False
With Sheets(1)
a = .Range("a2", .Range("a" & Rows.Count).End(xlUp)).Value
debut = Int(.Range("a2").Value)
fin = Int(.Range("a" & Rows.Count).End(xlUp).Value)
End With
With CreateObject("Scripting.Dictionary")
For i = debut To fin
.Item(i) = Empty
Next
For i = 2 To UBound(a, 1)
If .exists(Int(a(i, 1))) Then
.Item(Int(a(i, 1))) = True
End If
Next
For Each e In .keys
If Not IsEmpty(.Item(e)) Then .Remove e
Next
n = .Count: y = .keys
If n Then
With Sheets(1).Range("c1").Resize(n, 1)
.NumberFormat = "m/d/yyyy"
.FormulaLocal = Application.Transpose(y)
End With
End If
End With
'Application.ScreenUpdating = True
End Sub

sandra131313 · 24 Novembre 2016

Cher klin89

J'ai testé ton code avec le peu que je savais pour le coller dans le VB, et ça a marché !

Tu ne sais pas à quel point tu m'as ôté une épine du pied. Je suis admirative de tant de talent.

Merci infiniment !!!!!

Sandra

job75 · 25 Novembre 2016

Bonjour sandra131313, klin89,

Par curiosité j'ai voulu voir ce que ça pouvait donner sans Dictionary.

Eh bien cette macro s'exécute chez moi en 29 millièmes de seconde sur le fichier joint :

Code:

Sub TestSansDictionary()
Dim mini&, maxi&, a, t, i&
Application.ScreenUpdating = False
mini = Int(Application.Min([A:A])) - 1
maxi = Int(Application.Max([A:A]))
[C:C].ClearContents 'RAZ
If maxi - mini > 1 Then
  [C1] = CDate(mini + 1) 'date de départ
  With [C1].Resize(maxi - mini)
    .DataSeries Type:=xlChronological, Date:=xlDay 'remplissage
    a = .Value
    t = [A1].CurrentRegion
    For i = 2 To UBound(t)
      a(Int(t(i, 1)) - mini, 1) = ""
    Next
    .Value = a
    .Sort [C1], xlAscending, Header:=xlNo 'tri
  End With
End If
End Sub

Alors que la macro de klin89 (par ailleurs très bien) s'exécute en 47 millièmes de seconde.

Edit : j'ajoute le fichier pour tester les durées (1000 boucles).

A+

job75 · 25 Novembre 2016

Re,

En fait il faut utiliser autrement le Dictionary :

Code:

Sub Test_job75()
Dim mini&, maxi&, a() As Date, t, d As Object, i&, n&
Application.ScreenUpdating = False
mini = Int(Application.Min([A:A]))
maxi = Int(Application.Max([A:A]))
[C:C].ClearContents 'RAZ
If maxi > mini Then
  ReDim a(1 To maxi - mini, 1 To 1)
  t = [A1].CurrentRegion
  Set d = CreateObject("Scripting.Dictionary")
  For i = 2 To UBound(t)
    d(Int(t(i, 1))) = ""
  Next
  n = 0 'pas nécessaire ici (un seul passage)
  For i = mini + 1 To maxi - 1
    If Not d.exists(i) Then n = n + 1: a(n, 1) = i
  Next
  If n Then [C1].Resize(n) = a
End If
End Sub

Fichier (2), durée d'exécution 24 millièmes de seconde.

A+

sandra131313 · 29 Novembre 2016

job75 à dit:
Bonjour sandra131313, klin89,

Par curiosité j'ai voulu voir ce que ça pouvait donner sans Dictionary.

Eh bien cette macro s'exécute chez moi en 29 millièmes de seconde sur le fichier joint :

Code:

Sub TestSansDictionary() Dim mini&, maxi&, a, t, i& Application.ScreenUpdating = False mini = Int(Application.Min([A:A])) - 1 maxi = Int(Application.Max([A:A])) [C:C].ClearContents 'RAZ If maxi - mini > 1 Then [C1] = CDate(mini + 1) 'date de départ With [C1].Resize(maxi - mini) .DataSeries Type:=xlChronological, Date:=xlDay 'remplissage a = .Value t = [A1].CurrentRegion For i = 2 To UBound(t) a(Int(t(i, 1)) - mini, 1) = "" Next .Value = a .Sort [C1], xlAscending, Header:=xlNo 'tri End With End If End Sub

Alors que la macro de klin89 (par ailleurs très bien) s'exécute en 47 millièmes de seconde.

Edit : j'ajoute le fichier pour tester les durées (1000 boucles).

A+

sandra131313 · 29 Novembre 2016

Merci à tous de vous être impliqués ainsi, cela m'a sauvé d'un sacré travail de fourmi infini !

Vous êtes des chefs bienveillants.

MERCI INFINIMENT !!

Insertion automatique d'une colonne des dates manquantes

sandra131313

XLDnaute Nouveau

Pièces jointes

klin89

XLDnaute Accro

sandra131313

XLDnaute Nouveau

sandra131313

XLDnaute Nouveau

job75

XLDnaute Barbatruc

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

sandra131313

XLDnaute Nouveau

sandra131313

XLDnaute Nouveau

Discussions similaires