Macro
Bonjour,
J'exécute une macro et cela prend un certain temps l'écran est comme figé et excel affiche "Excel ne répond pas" puis tout redevient normal.
Qu'est-ce que je fait de pas correcte dans mon code pour allonger le temps d'exécution et d'avoir ce message à l'écran?
Voici mon code,
Merci,
Oiseau bleu
Sub Transférer_Soldes_Recevoir()
'
' Solde_Fact_Recevoir = onglet des factures à recevoir
'
Application.ScreenUpdating = False
Dim nblig As Long
Dim nblig2 As Long
Dim i As Long
Solde_Fact_Recevoir.Visible = True
Solde_Fact_Recevoir.Select
Solde_Fact_Recevoir.Unprotect Password:="1234"
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
nblig = Range("A" & Rows.Count).End(xlUp).Row
If nblig < 5 Then nblig = 5
Rows("5:" & nblig).Select
Selection.Delete Shift:=xlUp
État_Compte.Visible = True
État_Compte.Select
État_Compte.Unprotect Password:="1234"
If (Sheets("État de compte").AutoFilterMode And Sheets("État de compte").FilterMode) Or Sheets("État de compte").FilterMode Then
Sheets("État de compte").ShowAllData
End If
nblig2 = Range("A" & Rows.Count).End(xlUp).Row
Range("A5:A" & nblig2).Copy Solde_Fact_Recevoir.Range("A5")
Range("B5:I" & nblig2).Copy
Solde_Fact_Recevoir.Range("B5").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
État_Compte.Protect Password:="1234", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowFiltering:=True
État_Compte.Visible = False
Solde_Fact_Recevoir.Select
nblig = Range("A" & Rows.Count).End(xlUp).Row
Rows("5:" & nblig).Select
Solde_Fact_Recevoir.Sort.SortFields.Clear
Solde_Fact_Recevoir.Sort.SortFields.Add2 Key:=Range("H5:H" & nblig) _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
Solde_Fact_Recevoir.Sort.SortFields.Add2 Key:=Range("I5:I" & nblig) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Solde_Fact_Recevoir.Sort
.SetRange Range("A5:I" & nblig)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
For i = 5 To nblig
If Range("H" & i) = 0 Then
Range("I" & i) = ""
End If
If Range("G" & i) > 0 And Range("E" & i) <= Now + 35 Then
Range("A" & i & ":J" & i).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("J" & i).Select
ActiveCell.FormulaR1C1 = "Produire la facture"
With Selection.Font
.Name = "Calibri"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
End If
Next i
Range("A1").Select
Solde_Fact_Recevoir.Protect Password:="1234", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowFiltering:=True
Sheets("Écritures de transactions").Select
Solde_Fact_Recevoir.Visible = False
Application.ScreenUpdating = True
End Sub
Bonjour,
Voici un fichier pour mieux comprendre mon problème. J'aurais dû l'intégrer au départ Désolé.
Merci,
Oiseau bleu
re,
à tester,
dit-moi si c'est plus rapide ?
Sub Transférer_Soldes_Recevoir()
'
' Solde_Fact_Recevoir = onglet des factures à recevoir
'
Application.ScreenUpdating = False
Dim nblig As Long
Dim nblig2 As Long
Dim i As Long
With Solde_Fact_Recevoir
.Visible = True
If (.AutoFilterMode And .FilterMode) Or .FilterMode Then
.ShowAllData
End If
nblig = .Range("A" & Rows.Count).End(xlUp).Row
If nblig < 5 Then nblig = 5
.Rows("5:" & nblig).Delete Shift:=xlUp
End With
État_Compte.Visible = True
État_Compte.Select
If (Sheets("État de compte").AutoFilterMode And Sheets("État de compte").FilterMode) Or Sheets("État de compte").FilterMode Then
Sheets("État de compte").ShowAllData
End If
nblig2 = État_Compte.Range("A" & Rows.Count).End(xlUp).Row
État_Compte.Range("A5:A" & nblig2).Copy Solde_Fact_Recevoir.Range("A5")
État_Compte.Range("B5:I" & nblig2).Copy
Solde_Fact_Recevoir.Range("B5").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
État_Compte.Protect Password:="1234", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowFiltering:=True
With Solde_Fact_Recevoir
nblig = .Range("A" & Rows.Count).End(xlUp).Row
' Rows("5:" & nblig).Select
.Sort.SortFields.Clear
.Range("H5:H" & nblig).Sort key1:=.Range("H5"), order1:=xlAscending
.Range("I5:I" & nblig).Sort key1:=.Range("I5"), order1:=xlAscending
For i = 5 To nblig
If .Range("H" & i) = 0 Then .Range("I" & i) = ""
If .Range("G" & i) > 0 And .Range("E" & i) <= Now + 35 Then
With .Range("A" & i & ":J" & i)
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End With
With .Range("J" & i)
.Value = "Produire la facture"
With .Font
.Name = "Calibri"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
End With
End If
Next i
Application.Goto .Range("A1")
End With
Application.ScreenUpdating = True
Menu.Select
End SubBonjour et merci pour votre réponse.
D'après moi la vitesse d'exécution n'a pas augmenter.
Si on met en commentaire la commande Application.ScreenUpdating = False ; c'est la boucle du For qui ralentit le tout.
Présentement, il y a seulement 3 onglets; mais plus il y a d'onglet avec d'autres calculs plus l'exécution ralentit.
Est-ce que c'est le fait; qu'il y a plus d'espace mémoire utiliser?
Merci,
Oiseau bleu
Bonjour,
On peut penser que ce n'est pas la macro en elle même qui prend du temps mais le recalcul du classeur.
De plus tu utilises des formules assez chronophages donc il ne faut pas s'étonner surtout si les feuilles sont beaucoup plus longues...
Bien sur on peu optimiser la macro, mais je pense que c'est surtout l'ensemble qui est à revoir. (non pas parce que c'est mal foutu, mais pour avoir une vision d'ensemble plus précise.)
Voir aussi l'utilisation potentielle de Calcul "sur ordre" et d'un Array pour la macro.
En effet ce serait vingt fois plus rapide de passer par un Array pour coller tes valeurs et modifier le tableau plutôt que de scanner toutes le lignes... Mais là encore il faut voir le vrai fichier pour apprécier de quoi on parle. Si on parle vraiment d'une extraction de 200 lignes et d'un temps de 1 ou 2 secondes, ce n'est pas le même problème que si on est sur un tableau de 20 000 ou 200 000 lignes... avec un temps d'attente de 5 ou 10 minutes.
A+
Bonjour et merci pour votre répondre.
J'aimerais savoir ce que vous attendez par un "Calcul sur ordre"?
Comment utiliser un Array au lieu d'un For dans cette macro?
Le nombre de ligne peut monter jusqu'à 10 000 lignes.
J'aimerais savoir également lorsque j'utilise certain fichier excel par exemple je veux faire une mise en forme en utilisant le ruban en haut et je ne suis pas capable, ce qui se déroule du ruban et devenu plus pâle et je dois utiliser CTRL et 1 pour faire apparaître la boîte de format de cellule. Par la suite il arrive qu'excel gèle et je dois fermer excel et l'ouvrir à nouveau.
Merci de vos précieux conseil,
Oiseau bleu
Bonjour à tous,
nouvelle version à tester,
Sub Transférer_Soldes_Recevoir()
'
' Solde_Fact_Recevoir = onglet des factures à recevoir
'
Application.ScreenUpdating = False
Dim nblig As Long
Dim nblig2 As Long
Dim i As Long
With Solde_Fact_Recevoir
.Visible = True
If (.AutoFilterMode And .FilterMode) Or .FilterMode Then
.ShowAllData
End If
nblig = .Range("A" & Rows.Count).End(xlUp).Row
If nblig < 5 Then nblig = 5
.Rows("5:" & nblig).Delete Shift:=xlUp
End With
État_Compte.Visible = True
État_Compte.Select
If (Sheets("État de compte").AutoFilterMode And Sheets("État de compte").FilterMode) Or Sheets("État de compte").FilterMode Then
Sheets("État de compte").ShowAllData
End If
nblig2 = État_Compte.Range("A" & Rows.Count).End(xlUp).Row
État_Compte.Range("A5:A" & nblig2).Copy Solde_Fact_Recevoir.Range("A5")
État_Compte.Range("B5:I" & nblig2).Copy
Solde_Fact_Recevoir.Range("B5").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
État_Compte.Protect Password:="1234", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowFiltering:=True
Solde_Fact_Recevoir.Activate
nblig = Range("A" & Rows.Count).End(xlUp).Row
Range("K5:K" & nblig).Formula = "=IF(AND(G5 > 0,E5 <= TODAY() + 35),0,1)"
Range("A5:K" & nblig).Sort key1:=Range("K5"), order1:=xlAscending
nb0 = Application.Match(1, Range("K1:K" & nblig), 0) - 1
For i = 5 To nb0
If Range("H" & i) = 0 Then Range("I" & i) = ""
If Range("G" & i) > 0 And Range("E" & i) <= Now + 35 Then
With Range("A" & i & ":J" & i)
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End With
With Range("J" & i)
.Value = "Produire la facture"
With .Font
.Name = "Calibri"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
End With
End If
Next i
Sheets(" Soldes factures à recevoir").Range("K:K").ClearContents
Application.Goto Range("A1")
Application.ScreenUpdating = True
'Menu.Select
End Sub@oiseaubleu
merci de mettre ton code entre balise,
pour éditer ton 1er message
clic sur
sélectionne tout le code
et appui sur
Bonjour,
Calcul manuel c'est dans les Options d'Excel...
Si vous ovrez le menu Fichier / Options / Calcul vous avez 3 possibilités :
Calcul du classeur Automatique
Calcul du classeur Automatique excepté dans les tableaux de données
Et Manuel.
Dans le cas du calcul Manuel vous avez une option supplémentaire qui permet ou non le recalcul automatique avant d'enregistrer.
On utilise très souvent les Options Automatique ou Manuel en particulier pour les classeurs comportant un grand nombre de données et/ou des formules gourmandes.
On trouve également cette possibilité dans le ruban Formules (vers la droite : Options de calcul)
Il y a un raccourci pour provoquer le recalcul : [F9]
L'utilisation des Array ne dispense pas d'utiliser une boucle For.
En fait c'est le même principe qu'avec Excel mais on fait tout le boulot dans l'Array ce qui est beaucoup plus rapide que dans Excel car dans l'Array il n'y a pas de pb de format : Il ne gère que le contenu. Pas le décor.
Je tacherai de te faire ça en mode Array dans un moment parce que le collage spécial Value...
Par contre l'utilisation des Array n'est pas forcément intuitive : Compte tenu de l’intérêt ça mérite une petite période d'apprentissage !
Pour ton histoire de Format de cellule le menu est grisé parce que la feuille est protégé. Après, le raccourci je ne sais pas : Sans doute parce que quelqu'un l'a installé.
Là encore il y aurait sans doute d'autre possibilités, mais s'agissant d'un classeur bidon je ne peux pas me prononcer...
A+
Bonjour,
J'espère que j'ai réussi
Sub Transférer_Soldes_Recevoir()
'
' Solde_Fact_Recevoir = onglet des factures à recevoir
'
Application.ScreenUpdating = False
Dim nblig As Long
Dim nblig2 As Long
Dim i As Long
Solde_Fact_Recevoir.Visible = True
Solde_Fact_Recevoir.Select
Solde_Fact_Recevoir.Unprotect Password:="1234"
If (ActiveSheet.AutoFilterMode And ActiveSheet.FilterMode) Or ActiveSheet.FilterMode Then
ActiveSheet.ShowAllData
End If
nblig = Range("A" & Rows.Count).End(xlUp).Row
If nblig < 5 Then nblig = 5
Rows("5:" & nblig).Select
Selection.Delete Shift:=xlUp
État_Compte.Visible = True
État_Compte.Select
État_Compte.Unprotect Password:="1234"
If (Sheets("État de compte").AutoFilterMode And Sheets("État de compte").FilterMode) Or Sheets("État de compte").FilterMode Then
Sheets("État de compte").ShowAllData
End If
nblig2 = Range("A" & Rows.Count).End(xlUp).Row
Range("A5:A" & nblig2).Copy Solde_Fact_Recevoir.Range("A5")
Range("B5:I" & nblig2).Copy
Solde_Fact_Recevoir.Range("B5").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
État_Compte.Protect Password:="1234", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowFiltering:=True
État_Compte.Visible = False
Solde_Fact_Recevoir.Select
nblig = Range("A" & Rows.Count).End(xlUp).Row
Rows("5:" & nblig).Select
Solde_Fact_Recevoir.Sort.SortFields.Clear
Solde_Fact_Recevoir.Sort.SortFields.Add2 Key:=Range("H5:H" & nblig) _
, SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
Solde_Fact_Recevoir.Sort.SortFields.Add2 Key:=Range("I5:I" & nblig) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Solde_Fact_Recevoir.Sort
.SetRange Range("A5:I" & nblig)
.Header = xlGuess
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
For i = 5 To nblig
If Range("H" & i) = 0 Then
Range("I" & i) = ""
End If
If Range("G" & i) > 0 And Range("E" & i) <= Now + 35 Then
Range("A" & i & ":J" & i).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("J" & i).Select
ActiveCell.FormulaR1C1 = "Produire la facture"
With Selection.Font
.Name = "Calibri"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
End If
Next i
Range("A1").Select
Solde_Fact_Recevoir.Protect Password:="1234", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowFiltering:=True
Sheets("Écritures de transactions").Select
Solde_Fact_Recevoir.Visible = False
Application.ScreenUpdating = True
End SubBonjour,
Je me demande comment faire pour mettre le FOR dans une table ou Array et pour pointer sur le bon élément pour lui mettre la mise en forme que je désire???
Merci,
Oiseau bleu
Bonjour,
un exemple pour te permettre de visualiser :
Dim datas
datas = [A5].Resize(15, 5).Value ' tu lis tout en une fois (15 lignes, 5 colonnes depuis A5)
For lig = 1 To UBound(datas)
datas(lig, 3) = datas(lig, 1) * 2 ' tu travailles avec les valeurs de ton tableau datas(lig,col)
Next lig
[A5].Resize(15, 5) = datas ' tu colles le résultat en une foiseric
re,
autre version sans la boucle,
il est possible d'ajouter un trie en fin de macro
Sub Transférer_Soldes_Recevoir()
'
' Solde_Fact_Recevoir = onglet des factures à recevoir
'
Application.ScreenUpdating = False
Dim nblig As Long
Dim nblig2 As Long
Dim i As Long
With Solde_Fact_Recevoir
.Visible = True
If (.AutoFilterMode And .FilterMode) Or .FilterMode Then
.ShowAllData
End If
nblig = .Range("A" & Rows.Count).End(xlUp).Row
If nblig < 5 Then nblig = 5
.Rows("5:" & nblig).Delete Shift:=xlUp
End With
État_Compte.Visible = True
État_Compte.Select
If (Sheets("État de compte").AutoFilterMode And Sheets("État de compte").FilterMode) Or Sheets("État de compte").FilterMode Then
Sheets("État de compte").ShowAllData
End If
nblig2 = État_Compte.Range("A" & Rows.Count).End(xlUp).Row
État_Compte.Range("A5:A" & nblig2).Copy Solde_Fact_Recevoir.Range("A5")
État_Compte.Range("B5:I" & nblig2).Copy
Solde_Fact_Recevoir.Range("B5").PasteSpecial (xlPasteValues)
Application.CutCopyMode = False
État_Compte.Protect Password:="1234", DrawingObjects:=True, Contents:=True, Scenarios:=True _
, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowFiltering:=True
Solde_Fact_Recevoir.Activate
nblig = Range("A" & Rows.Count).End(xlUp).Row
Range("K5:K" & nblig).Formula = "=IF(AND(G5 > 0,E5 <= TODAY() + 35),0,1)"
Range("A5:K" & nblig).Sort key1:=Range("K5"), order1:=xlAscending
nb0 = Application.Match(1, Range("K1:K" & nblig), 0) - 1
With Range("A5:J" & nb0)
With .Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End With
With Range("J5:J" & nb0)
.Value = "Produire la facture"
With .Font
.Name = "Calibri"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
End With
Sheets(" Soldes factures à recevoir").Range("K:K").ClearContents
Application.Goto Range("A1"), True
Application.ScreenUpdating = True
'Menu.Select
End SubBonjour et merci pour vos réponses,
J'ai essayé le fichier de I20100, il fonctionne parfaitement; mais quand je l'intègre dans l'ensemble que j'ai créer il y a des délais qui sont trop longs.
J'essai maintenant avec un table; mais j'ai de la difficulté à convertir le tout dans une table.
Comment faire pour convertir le fameux FOR dans une table??
datas = [A5].Resize(nblig, 9).Value
For i = 1 To UBound(datas)
If datas(8, i) = 0 Then
datas(9, i) = ""
End If
If datas(8, i) > 0 And datas(5, i) <= Now + 35 Then
datas(1,i) 'je dois sélectionner la ligne comment sélectionner une ligne avec une table pour mettre la couleur et le format désiré????Je suis bloqué parce que je ne sais pas comment sélectionner une ligne pour mettre une couleur intérieure et un format.
Avec le For c'est
For i = 5 To nblig
If Range("H" & i) = 0 Then
Range("I" & i) = ""
End If
If Range("G" & i) > 0 And Range("E" & i) <= Now + 35 Then
Range("A" & i & ":J" & i).Select
With Selection.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
Range("J" & i).Select
ActiveCell.FormulaR1C1 = "Produire la facture"
With Selection.Font
.Name = "Calibri"
.Size = 8
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ThemeColor = xlThemeColorLight1
.TintAndShade = 0
.ThemeFont = xlThemeFontMinor
End With
End If
Next iMerci encore,
Oiseau bleu
re,
Comment faire pour convertir le fameux FOR dans une table??
il n'y a aucun for dans la dernière macro transmit
Bonjour,
lire les commentaires du code : ' ... datas(lig,col)
Si tu inverses lig et col ça ne va pas le faire.
eric
Bonjour,
Voici le code qui a plus d'allure.
Mais je ne sais pas comment sélectionner une ligne pour faire la couleur et la mise en forme???
For i = 1 To UBound(datas)
If datas(i, 8) = 0 Then
datas(i,9) = ""
End If
If datas(i,8) > 0 And datas(i, 5) <= Now + 35 Then
datas(i,1) 'je dois sélectionner la ligne comment sélectionner une ligne avec une table pour mettre la couleur et le format désiré????Oiseau bleu