XL 2019 Lenteur d'exécution : optimisation

P

Pieerre69

XLDnaute Junior
Bonjour,

Je suis en train de faire une petite application, qui copie colle des données d'une interface de saisie vers une feuille préparée pour faire de l'extraction sur une autre application.
Le code fonctionne très bien (il fait ce que je lui demande, c'est déjà pas mal!) mais il est très long à tourner..
Surtout que j'ai pour le moment 15 lignes, alors qu'il est possible que j'en ai beaucoup plus à l'avenir.

VB: 
Sub lancement_cde()

'déclaration des variables
Dim nbligne As Integer
Dim i As Integer


    If MsgBox("Avez-vous terminé de saisir ?", vbYesNo, "Confirmation de saisie") = vbNo Then
    
        MsgBox ("Veuillez continuer la saisie")
    
        Else
            'comptage de la dernière ligne remplie
            nbligne = Worksheets("Saisie").Range("A" & Rows.Count).End(xlUp).Row - 2
            
            'Recup data
            For i = 1 To nbligne
                
                Application.ScreenUpdating = False
                'recup auto
                Worksheets("Interface").Range("A" & i + 1).Value = "100"
                Worksheets("Interface").Range("B" & i + 1).Value = Worksheets("Saisie").Range("H" & i + 2).Value
                Worksheets("Interface").Range("D" & i + 1).Value = Worksheets("Saisie").Range("C" & i + 2).Value
                Worksheets("Interface").Range("E" & i + 1).Value = Worksheets("Saisie").Range("D" & i + 2).Value
                Worksheets("Interface").Range("F" & i + 1).Value = Worksheets("Saisie").Range("E" & i + 2).Value
                Worksheets("Interface").Range("K" & i + 1).Value = Worksheets("Saisie").Range("G" & i + 2).Text
                
                'recup manu
                Worksheets("Interface").Range("C" & i + 1).Value = Format(Day(Date), "00") & "-" & Format(Month(Date), "00") & "-" & Year(Date)
                
            Next
    End If
End Sub

Avez-vous des idées pour modifier ce code afin de le rendre plus performant/exécution plus rapide ?

Merci
 

Pièces jointes

  • HEKIPIA - Demande d'approvisionnement.xlsm
    101.5 KB · Affichages: 10
Solution
chris
Re
Bonjour pierrejean :)

VB: 
Sub lancement_cde()

'déclaration des variables
Dim nbligne As Integer
Dim wb1 As Workbook
Dim TDates
Dim i As Long

Application.ScreenUpdating = False

    If MsgBox("Avez-vous terminé de saisir ?", vbYesNo, "Confirmation de saisie") = vbNo Then
        MsgBox ("Veuillez continuer la saisie")
        Exit Sub
    End If
   
    'comptage de la dernière ligne remplie
    nbligne = Worksheets("Saisie").Range("A" & Rows.Count).End(xlUp).Row - 2
    'Recup data
    Worksheets("Interface").Range("A2:A" & nbligne).Value = "100"
    Worksheets("Interface").Range("D2:F" & nbligne + 1) = Worksheets("Saisie").Range("C3:E" & nbligne + 2).Value
    Worksheets("Interface").Range("B2:B" & nbligne + 1) =...
Trier par date Trier par votes
chris

chris

XLDnaute Barbatruc
Bonjour
VB: 
Sub lancement_cde()

'déclaration des variables
Dim nbligne As Integer
Dim wb1 As Workbook


    If MsgBox("Avez-vous terminé de saisir ?", vbYesNo, "Confirmation de saisie") = vbNo Then
        MsgBox ("Veuillez continuer la saisie")
        Exit Sub
    End If
    
    'comptage de la dernière ligne remplie
    nbligne = Worksheets("Saisie").Range("A" & Rows.Count).End(xlUp).Row - 2
    'Recup data
    Worksheets("Interface").Range("A2:A" & nbligne).Value = "100"
    Worksheets("Interface").Range("D2:F" & nbligne + 1) = Worksheets("Saisie").Range("C3:E" & nbligne + 2).Value
    Worksheets("Interface").Range("B2:B" & nbligne + 1) = Worksheets("Saisie").Range("H3:H" & nbligne + 2)
    Worksheets("Interface").Range("K2:K" & nbligne + 1) = Worksheets("Saisie").Range("G3:G" & nbligne + 2)
  
End Sub
 
Vote positif 0 Vote négatif
P

Pieerre69

XLDnaute Junior
Salut,

Merci pour la réponse. Cependant le copier-coller de la colonne K de la fiche interface ne fonctionne pas.
Je copie colle un ensemble de données texte (le format a respecté c'est "aaaammjj". La zone de collage, ici Interface, doit être au format texte quoi qu'il arrive et non personnalisé.

C'est pour ça que moi je faisais range.value = range.text
 
Vote positif 0 Vote négatif
chris

chris

XLDnaute Barbatruc
Re
Bonjour pierrejean :)

VB: 
Sub lancement_cde()

'déclaration des variables
Dim nbligne As Integer
Dim wb1 As Workbook
Dim TDates
Dim i As Long

Application.ScreenUpdating = False

    If MsgBox("Avez-vous terminé de saisir ?", vbYesNo, "Confirmation de saisie") = vbNo Then
        MsgBox ("Veuillez continuer la saisie")
        Exit Sub
    End If
   
    'comptage de la dernière ligne remplie
    nbligne = Worksheets("Saisie").Range("A" & Rows.Count).End(xlUp).Row - 2
    'Recup data
    Worksheets("Interface").Range("A2:A" & nbligne).Value = "100"
    Worksheets("Interface").Range("D2:F" & nbligne + 1) = Worksheets("Saisie").Range("C3:E" & nbligne + 2).Value
    Worksheets("Interface").Range("B2:B" & nbligne + 1) = Worksheets("Saisie").Range("H3:H" & nbligne + 2).Value
    TDates = Worksheets("Saisie").Range("G3:G" & nbligne + 2)
    For i = 1 To UBound(TDates, 1)
        TDates(i, 1) = Format(TDates(i, 1), "yyyymmdd")
    Next i
        Worksheets("Interface").Range("K2:K" & nbligne + 1) = TDates

End Sub
 
Vote positif 0 Vote négatif
Solution
P

Pieerre69

XLDnaute Junior
chris à dit:
Re
Bonjour pierrejean :)

VB: 
Sub lancement_cde()

'déclaration des variables
Dim nbligne As Integer
Dim wb1 As Workbook
Dim TDates
Dim i As Long

Application.ScreenUpdating = False

    If MsgBox("Avez-vous terminé de saisir ?", vbYesNo, "Confirmation de saisie") = vbNo Then
        MsgBox ("Veuillez continuer la saisie")
        Exit Sub
    End If
  
    'comptage de la dernière ligne remplie
    nbligne = Worksheets("Saisie").Range("A" & Rows.Count).End(xlUp).Row - 2
    'Recup data
    Worksheets("Interface").Range("A2:A" & nbligne).Value = "100"
    Worksheets("Interface").Range("D2:F" & nbligne + 1) = Worksheets("Saisie").Range("C3:E" & nbligne + 2).Value
    Worksheets("Interface").Range("B2:B" & nbligne + 1) = Worksheets("Saisie").Range("H3:H" & nbligne + 2).Value
    TDates = Worksheets("Saisie").Range("G3:G" & nbligne + 2)
    For i = 1 To UBound(TDates, 1)
        TDates(i, 1) = Format(TDates(i, 1), "yyyymmdd")
    Next i
        Worksheets("Interface").Range("K2:K" & nbligne + 1) = TDates

End Sub
Cliquez pour agrandir...


Ce bout de code fonctionne ! Merci pour ton aide
Que fait la fonction UBound ?
 
Vote positif 0 Vote négatif
patricktoulon

patricktoulon

XLDnaute Barbatruc
re
pour le fun et m'amuser un peu ,j'ai ajouté une feuille "Feuil1" et .....
VB: 
Sub testx()
    Dim plage As Range, vide&, colonne_a_recuperer
    vide = 200    ' on prevoit une colonne vide pour les intersticeson la prend loin des colonnes utilisées pour etre sur
    With Sheets("Saisie")
        Set maplage = .Range("A3").Resize(.Cells(Rows.Count, 1).End(xlUp).Row - 2, vide)  'je dimentionne la plage de "saisie" a 200 colonnes
    End With
    colonne_a_recuperer = Array(100, 8, vide, 3, 4, 5, vide, vide, vide, vide, 7)    'dans l'ordre dans le quel on les veux
    transfert maplage, colonne_a_recuperer
End Sub

Function transfert(plage, arrcolumns) As String
    Dim va
    va = Application.Index(plage.Value2, Evaluate("ROW(" & 1 & ":" & plage.Rows.Count & ")"), arrcolumns)    'mettre les colonnes que l'on veut dans l'ordre voulues
    With Sheets("Feuil1")
        .Cells(2, 1).Resize(UBound(va), UBound(va, 2)) = va
        .Cells(2, 1).Resize(UBound(va)) = "100"
        .Cells(2, 3).Resize(UBound(va)) = Format(Date, "dd-mm-yyyy")
        .Cells(2, 2).Resize(UBound(va)).NumberFormat = "000000"
        .Cells(2, 4).Resize(UBound(va)).NumberFormat = "000000"
    End With
End Function
amis du jour bonjour
;)
 
Vote positif 0 Vote négatif

Discussions similaires

T
  • Question
XL 2016 Optimisation d'une boucle
2 3
Réponses
30
Affichages
896
thivame
T
FRYS
  • Question
Microsoft 365 Retrouver les dépendants de cellules nommées
Réponses
6
Affichages
202
crocrocro
C
E
  • Question
XL 2013 vba excel
Réponses
6
Affichages
230
sylvanu
sylvanu
B
  • Question
Microsoft 365 [RESOLU] Supprimer Ligne rapidement et avec plusieurs conditions
Réponses
5
Affichages
98
BENAM69
B
S
  • Résolu(e)
XL 2016 problème de filtre dans listbox
2 3 4
Réponses
51
Affichages
1 K
saidoush
S
G
  • Question
Microsoft 365 Saut de ligne dans une cellule
Réponses
3
Affichages
126
GClaire
G
Y
  • Question
Microsoft 365 récupérer données de tableau structuré sur une plage
Réponses
2
Affichages
245
jpb388
jpb388
E
  • Résolu(e)
Microsoft 365 Ajout et Suppression Date automatique
Réponses
9
Affichages
179
eric72
E
S
  • Question
XL 2016 VBA EXCEL
Réponses
2
Affichages
311
simon-baril01
S
halecs93
  • Résolu(e)
XL 2016 Indice n'appartient pas à la sélection : HELP !!!!
2
Réponses
21
Affichages
526
halecs93
halecs93

Membres actuellement en ligne

12 membres et 101 invités.

Partager cette page

Tutos vidéos

Power Query : Ajouter des requêtes (Excel et Power BI)
Créez votre première fonction LAMBDA dans Excel en 3 étapes!
LAMBDA, l’arme secrète de Microsoft pour Excel !
Office Insider - Découvrez les nouveautés Excel avant tout le monde

Statistiques des forums

Discussions
312 109
Messages
2 085 384
Membres
102 878
dernier inscrit
asmaa