Accélérer la fonction Range

Bonjour,

Je n'ai pas réussit à trouver un bon titre mais voilà le problème.

Quand je fais cette commande ...

Tableau = Range("A" & decalage, Cells(nbL + decalage, 22))

... mon fichier excel se met en "ne réponds pas" puis continue jusqu'à finir correctement le programme.

Ma question est donc : Serait-il possible d'éviter cela avec une autre function ?

ps: j'essaye de copié une partie de mon fichier excel dans un tableau

Merci pour vos futurs réponses.

Cordialement.

Bonjour,

Eh bien moi aussi je suis "en répond pas"

Faudrait peut-être voir un peu plus de ton code, voir même un bout de fichier

J'ai fais quelques tests avec des MsgBox pour voir où ça rammé, et c'est avec cette ligne là. Mais pas de soucis j'affiche le code complet et si au passage il y a quelques modification à faire

Sub Ratio_Heure()
    Dim stfile, nomFichier, nbLFichier2, nbL%, nbC%, Tableau(), decalage, prov, TabFinal(), UOE, nomCourant, prenomCourant, nbPersonneDifferente, cptPersonne, verification
    Dim wB  As Workbook

    nomFichier = ThisWorkbook.Name
    stfile = Application.GetOpenFilename
    If Not VarType(stfile) = vbBoolean Then
        Set wB = Workbooks.Open(Filename:=stfile)

        MsgBox "Vous allez travailler sur le fichier " & stfile
        nbL = WorksheetFunction.CountA(Range("A:A")) + 1   ' nombre de ligne
        For j = 1 To nbL
            If Cells(j, 1) = "Direction" Then
                decalage = j
                j = nbL
            End If
        Next

        nbL = nbL - decalage
        nbC = Cells(decalage, Columns.Count).End(xlToLeft).Column ' nombre de colonne

        Tableau = Range("A" & decalage, Cells(nbL + decalage, 22))      ' Tableau en entier
        ' effacer les cases du fichier
        For i = 1 To nbL + decalage
            For j = 1 To nbC
                Cells(i, j).ClearContents
            Next
        Next

        ' écrire dans les cellules A1 B1 et C1
        Cells(1, 1) = "Nom"
        Cells(1, 2) = "Prenom"
        Cells(1, 3) = "UOE"

        ' recopier le tableau dans les cellules
        For i = 2 To nbL + 1
            Cells(i, 1) = Tableau(i, 7)
            Cells(i, 2) = Tableau(i, 8)
            prov = CDbl(Tableau(i, 21))
            Cells(i, 3) = prov
        Next

        ' DEUXIEME ETAPE
        nomCourant = " "
        prenomCourant = " "
        UOE = 0
        nbPersonneDifferente = 0 ' nombre total de personne
        cptPersonne = 1 ' compteur de personne

        'trouver le nombre de personne différente
        For i = 2 To nbL
            If Not Cells(i, 1) = nomCourant Or Not Cells(i, 2) = prenomCourant Then
                nbPersonneDifferente = nbPersonneDifferente + 1
                nomCourant = Cells(i, 1)
                prenomCourant = Cells(i, 2)
            End If
        Next
        TabFinal = Range("A2", Cells(nbL + 2, 3)) ' tableau trié

        nomCourant = TabFinal(1, 1)
        prenomCourant = TabFinal(1, 2)
        UOE = TabFinal(1, 3)

        For i = 2 To nbL + 1
            If TabFinal(i, 1) = nomCourant And TabFinal(i, 2) = prenomCourant Then
                UOE = UOE + TabFinal(i, 3)
            Else
                    Cells(cptPersonne + 1, 1) = nomCourant
                    Cells(cptPersonne + 1, 2) = prenomCourant
                    Cells(cptPersonne + 1, 3) = UOE
                    nomCourant = TabFinal(i, 1)
                    prenomCourant = TabFinal(i, 2)
                    UOE = TabFinal(i, 3)
                    cptPersonne = cptPersonne + 1
            End If
        Next

        ' on efface les dernières lignes inutiles
        For i = cptPersonne + 1 To nbL + 1
            For j = 1 To 3
                Cells(i, j).ClearContents
            Next
        Next

        ' affiche la fenetre de demande du nombre de jours travaillé
        Cells(2, 5) = "nbJours"
        nbJours.Show

        ' On verifie si tout le monde a travaillé le bon nombre de jour
        verification = True
        For i = 1 To nbPersonneDifferente - 1
            If Not Cells(i + 1, 3) = Cells(2, 6) Then
                verification = False
            End If
        Next

        'on colorie la case vert si tout le monde est ok, rouge s'il quelqu'un n'a pas fait tout les jours.

        If verification Then
            Workbooks(nomFichier).Sheets(2).Range("H24").Interior.Color = RGB(0, 255, 0)
            Workbooks(nomFichier).Sheets(2).Range("H24").Value = "OK"
            Workbooks(nomFichier).Sheets(2).Range("I24").Interior.Color = RGB(0, 255, 0)
            Workbooks(nomFichier).Sheets(2).Range("I24").Value = "OK"
        Else
            Workbooks(nomFichier).Sheets(2).Range("H24").Interior.Color = RGB(255, 0, 0)
            Workbooks(nomFichier).Sheets(2).Range("H24").Value = "KO"
            Workbooks(nomFichier).Sheets(2).Range("I24").Interior.Color = RGB(255, 0, 0)
            Workbooks(nomFichier).Sheets(2).Range("I24").Value = "KO"
        End If

        ActiveWorkbook.Close False
    End If
End Sub

Je vais clore ce sujet, bizarrement ça refonctionne ... Peut être une surcharge du pc je sais pas.

Rechercher des sujets similaires à "accelerer fonction range"