Tableau pour accélérer une procédure

Bonjour au forum,

J'ai découvert il y a peu la puissance des tableaux en VBA, en particulier concernant la rapidité d'exécution du code.

Savez-vous s'il serait possible d'utiliser des tableaux pour ce type de manipulation (qui prennent un temps très conséquent sur 60 000 lignes...) ?

        For Each c In Range("AC11:AC" & dl3)
            c.Value = WorksheetFunction.Proper(Format(c.Offset(0, -28), "dddd"))
        Next c

        For Each c In Range("J11:J" & dl3)
            If DateDiff("yyyy", c.Offset(0, -3), Now, vbMonday) < 65 Then
            c.Value = "< 65 ans"
            Else: c.Value = ">= 65 ans"
            End If
        Next c

Merci d'avance pour votre aide !

bonjour,

une proposition vba, tu peux également jeter un oeil du coté de powerquery

    Dim ta(), tb()
    dl3 = Cells(Rows.Count, 1).End(xlUp).Row
    ReDim ta(1 To dl3 - 10, 1 To 1), tb(1 To dl3 - 10, 1 To 1)
    td = Range("A11:A" & dl3).Value 'AC11.offset(0,-28)
    tm = Range("G11:G" & dl3).Value 'J11.offset(0,-3)

     dl3 = Cells(Rows.Count, 1).End(xlUp).Row 'valeur pour dl3 à adapter

    For i = LBound(td) To UBound(td)
        ta(i, 1) = Format(td(i, 1), "dddd")
        Mid(ta(i, 1), 1, 1) = UCase(Left(ta(i, 1), 1))
        If DateDiff("yyyy", tm(i, 1), Now, vbMonday) < 65 Then tb(i, 1) = "< 65 ans" Else tb(i, 1) = ">= 65 ans"
    Next i

    Range("AC11:AC" & dl3).Value = ta
    Range("J11:J" & dl3).Value = tb

Bonjour h2so4,

Merci beaucoup pour ta réponse, j'ai pu l'adapter à mon fichier et je suis passé d'un traitement de 2:40 à 20sec :)

Sans vouloir abuser de ton aide et de ton temps, pourrais-tu m'aider également pour ces bouts de code ? :

    With ws1

    dl3 = ws1.Range("B" & Rows.Count).End(xlUp).Row
    plA = ws1.Range("A" & Rows.Count).End(xlUp).Row + 1
'-----------------------------------------------------------------------------------------------------------------------
        For Each C In Range("A" & plA & ":A" & dl3)
            If C.Value = 0 Then
                C = Date ' Format(Now, "dd/mm/yyyy hh:mm") 'date du jour ou date du jour + heure
            End If
        Next C
'-----------------------------------------------------------------------------------------------------------------------
    plR = ws1.Range("R" & Rows.Count).End(xlUp).Row + 1
        For Each C In Range("R" & plR & ":R" & dl3)
            Select Case Mid(C.Offset(0, -8), 1, 2)
                Case "D+"
                C.Value = "RhD+"
                Case "D-"
                C.Value = "RhD-"
                Case Else
                C.Value = "PCR en cours"
            End Select
        Next C

et celui-ci pour un autre fichier :

dlOB = OB.Range("A" & Rows.Count).End(xlUp).Row
For Each c In OB.Range("A2:A" & dlOB)
    c.Value = DateSerial(Year(c), Month(c), Day(c))
Next c

Un très grand merci d'avance... !

bonjour,

voici pour ta première demande

    With ws1
        dl3 = .Range("B" & Rows.Count).End(xlUp).Row
        pla = .Range("A" & Rows.Count).End(xlUp).Row + 1
        plr = .Range("R" & Rows.Count).End(xlUp).Row + 1
        tca = .Range("A" & pla & ":A" & dl3)
        tcj = .Range("J" & plr & ":J" & dl3)
        ReDim tb(1 To UBound(tcj), 1 To 1)
        For i = 1 To UBound(tca)
            If tca(i, 1) = 0 Then tca(i, 1) = Now
        Next i
        For i = 1 To UBound(tcj)
            Select Case Left(tcj(i, 1), 2)
                Case "D+"
                    tb(i, 1) = "RhD+"
                Case "D-"
                    tb(i, 1) = "RhD-"
                Case Else
                    tb(i, 1) = "PCR en cours"
            End Select
        Next i
        .Range("A" & pla & ":A" & dl3).Value = tca
        .Range("R" & plr & ":R" & dl3).Value = tb
    End With

la deuxième (pour un autre fichier) est inutile puisque cela revient à mettre dans la cellule la date qui s'y trouve déjà.

Bonjour h2so4,

Merci beaucoup pour tes réponses.

J'étais en vacances donc n'ai pas pu encore tester tout ça, mais je voulais quand même déjà te remercier pour m'avoir répondu :)

Je regarde ça dans la semaine et reviendrai vers toi !

Merci !

Bonjour h2so4,

Tout d'abord, bonne année à toi et au forum.

J'ai pu tester tes différentes solutions et tout fonctionne parfaitement.

Merci infiniment pour ton aide, je suis passé de plusieurs minutes de traitement à quelques dizaines de secondes... Va vraiment falloir que je me mette à ces tableaux en VBA... !

Concernant ce bout de code, il me semble qu'il me permet de "forcer" le format Date, l'import des données se faisant d'un fichier généré par un logiciel mettant tout au format Texte :

la deuxième (pour un autre fichier) est inutile puisque cela revient à mettre dans la cellule la date qui s'y trouve déjà.

dlOB = OB.Range("A" & Rows.Count).End(xlUp).Row
For Each c In OB.Range("A2:A" & dlOB)
    c.Value = DateSerial(Year(c), Month(c), Day(c))
Next cla deuxième (pour un autre fichier) est inutile puisque cela revient à mettre dans la cellule la date qui s'y trouve déjà.

Je me trompe ?

Merci encore et bonne journée !

Bonjour à tous,

Une proposition via Power Query (61.000 dates.....) :