Architecture du code pour temps de calcul trop long ?

Bonjour

j'ai un code dont la fonctionnalité est d'aller chercher des données dans une base de données pour remplir un ficher qui servira à l'import de celles-ci sur mon site web.

Jusque là, tout marchait pas trop mal, pas trop long.

Les données étaient réparties sur une même feuille.

Maintenant, à cause des langues, j'ai été obligé de créer une nouvelle feuille et le remplissage se fait donc en allant pêcher les infos sur deux feuilles du même classeur, pour aller les remplir sur un second classeeur qui sera lui, importé.

Le principe est simple, mes articles sont rangés ligne par ligne (2500) avec environ 320 colonnes:

- Je fais le test ligne à ligne sur la source,

- l'article remplit il les 4 conditions à chaque ligne;

- dès lors que les 4 conditions sont remplies, on va sur la première ligne du fichier cible, on y reporte le code article en première colonne et on distribue les données collectées de la source sur 350 colonnes imposées dont je ne peux modifier ni la trsucture ni les titres, ni l'ordre; et ceci, colonne par colonne donc

Puis on passe à la ligne suivante de la source pour reporter sur la ligne suivante de la cible.

En réalité, les données sources se trouvaiant deja sur deux feuille, peu sur la seconde.

Dans ce cas, le pgm balayait cà en qques minutes

Mais depuis l'arrivé d'une langue supplémentaire, j'ai été obligé de créer une 3° feuille source.

Depuis l'extension des données sources, j'ai été obligé de créer un seconde feuille de langue et là, catastrophe, le programme met des heures...je me suis couché avant.

Sub Mod16NEW_FFFB_NL()
'141120 Créé sur la base de AMZ_FR_FFFB_
'Ce CODE remplit la  feuille AMZ (version 2020.0112) et créé le fichier FFFB_NL-vXXXX-Complet.xlsm pour import de produits nouveaux de la base
'APPLICABLE à tous les produits de l'offre
' Produit non créé => Création
' Produit déja créé => MAJ PQ
'MISES A JOUR
' Corrections sur la base du modèle qui marche Version=2020.0112.

    Dim DL As Long
    Dim PL As Long
'   Dim TC As Long
    Dim PLF As Long
    Dim DLF As Long
    Dim DLT As Long
    Dim code As Variant
    Dim Action As Variant
    Dim name As String
    Dim version As String
    Dim sNomFic As String, sNomSauv As String, sPath As String, sNomSauvor As String 'déclarations pour garder le nom du fichier

    version = "v1411"

    Dim wb1 As Workbook 'FICHIER SOURCE: BAU
    Dim wb2 As Workbook 'FICHIER CIBLE:FFFBN
    Dim wb3 As Workbook 'CIBLE: MAJ PQ
    Dim ws1 As Worksheet
    Dim ws11 As Worksheet
    Dim ws2 As Worksheet
    Dim ws3 As Worksheet

    Set wb1 = ThisWorkbook '("GRANDE BASE JJMMCKJJMM")
    Set ws1 = wb1.Worksheets("Epicerie")
    Set ws11 = wb1.Worksheets("Sevellia")
    Set ws12 = wb1.Worksheets("NL")

'   Paramétrage du nom du fichier source AVANT IMPORT
    sPath = ActiveWorkbook.Path & "\"   'chemin de stockage de la BAU initiale
    sNomFic = ThisWorkbook.name    ' Nom du fichier
    sNomSauv = Left(sNomFic, Len(sNomFic) - Len(".xlsm")) ' récupération de la partie qui m'intéresse, ici, tout à gauche de xlsm
    sNomSauvor = sNomSauv
    sNomSauv = sNomSauv & " avant Import PQ du " & Format(Now(), "mmdd-hhmm") & ".xlsm" 'création du nouveau nom

'   Sauvegarde du fichier AVANT IMPORT
'    ActiveWorkbook.SaveAs sPath & "Sauvegardes BDD avant Import\" & sNomSauv  'sauvegarde du fichier
    ' si j'avais pas voulu le garder actif, j'aurais mis : ActiveWorkbook.SaveCopyAs sPath & sNomSauv

' Ouverture des fichiers cibles modèles FFFBN. ATTENTION A BIEN VERIFIER QUE CES FICHIERS SONT VIDES !!!
    Set wb2 = Workbooks.Open("\\PARTENAIRES MD\INTERNET\MARKET PLACE\AMAZON\Fichier Exportés AMZ\Modèles\Fichiers pour mise à jour\foodandbeverages_nl.xlsm")
    Set ws2 = wb2.Worksheets("Sjabloon")
    Set wb3 = Workbooks.Open("\\\PARTENAIRES MD\INTERNET\MARKET PLACE\AMAZON\Fichier Exportés AMZ\Modèles\Fichiers pour mise à jour\Flat.File.Price.Inventory.xlsm")
    Set ws3 = wb3.Worksheets("Price Template")

    ws1.Activate

'PARAMETRAGES DE L'ETENDUE
    PL = 8
    DL = ws1.Range("C" & Rows.Count).End(xlUp).Row
    DC = ws1.Cells(4, Cells.Columns.Count).End(xlToLeft).Column
'    MsgBox (Dc)

'Tri par numéro d'article (INDISPENSABLE)de la BAU
    'Le tri s'opère sur le fichier actif car il est lancé à partir de lui, et on a activé la feuille 1
    ws1.Range("A8" & ":JZ" & DL).Select 'Modifier en "currentregion"
    Selection.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
    OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
    DataOption1:=xlSortNormal

'Choix de la mise à jour pour suppression, création, actualisartion partielle
    Action = "Bijwerken"

    ' MsgBox DL
'RESTRICTION EVENTUELLE DE L'ETENDUE
'au pire, DL est la dernière ligne dont la colonne F (6-Fournisseur ou C) n'est pas vide
     If MsgBox("Voulez-vous réduire le champ de l'import ?", vbYesNo, "Choix du périmètre") = vbYes Then
        code = "p" 'p comme partiel, champ réduit
        ' affectation des valeurs de début et fin
        PL = InputBox("Entrez la valeur de la première ligne", "Première ligne", 8)
        DL = InputBox("Entrez la valeur de la dernière ligne", "Dernière ligne", DL)
        name = InputBox("Entrez un titre pour cet Export:", "Titre de l'Export", "Global")
    Else
        code = "c" 'c comme complet, champ total
        PL = 8
        DL = ws1.Range("C" & Rows.Count).End(xlUp).Row
        name = "Complet"
    End If

    MsgBox "L'étendue va de " & PL & " à " & DL

'BOUCLE DE CREATION DES FICHIERS ( Nouveautés et MAJ PQ)
    ws1.Activate
' j ligne de FFFB, onglet Modèle, commence à la ligne 4
    j = 4
    k = 2

' CHAMP DES PRODUITS IMPORTES

For i = PL To DL

' CONDITIONS d'application de la mise à jour (NOUVEAU)
    'Condition 1 - Produit STOCK >0 (DR)
'        If Range("DR" & i).Value > 0 Then
        If ws1.Cells(i, 122) > 0 Then
    'Condition 2 - Produit autorisé pour AMZ (CW)
'        If ws1.Range("CW" & i).Value <> "N" Then
        If ws1.Cells(i, 101) <> "N" Then
    'Condition 3 - Produit complet (A affiner ultérieurement pour s'assurer des présences des traductions)
        If ws1.Cells(i, 251) = "O" Then
    'Condition 4 - Produit Nouveau (Pas de date de création pas d'ASIN existant: Col FG; Mise a jour col EO); pour les autres pays, ce sera "-"
'        If ws1.Range("EO" & i) = "" Then
        If ws12.Cells(i, 17) = "" Then

' REMPLISSAGE DES DONNEES DANS WS2

        'Colonne A = 1 "feed_product_type"
            ws2.Cells(j, 1) = "grocery"

        'Colonne B = 2 "item_sku"
            ws2.Cells(j, 2) = ws1.Cells(i, 1)

        'Colonne C = 3 "brand_name"
'        If Range("I" & i).Value = "" Then 'pas d4EAN
            If ws1.Cells(i, 9) = "" Then
           ws2.Cells(j, 3) = "Generiek"
           Else
           ws2.Cells(j, 3) = ws1.Cells(i, 7)
           End If

        'Colonne D = 4 "External Product Id"
            ws2.Cells(j, 4) = ws1.Cells(i, 9)
            ws2.Cells(j, 4).NumberFormat = "0"

        'Colonne E = 5 "external_product_id_type"
'            If Range("F" & i).Value = "xxx" Then
            If ws1.Cells(i, 6).Value = "xxx" Then
            ws2.Cells(j, 5) = "" 'ATTENTION à corriger
            Else
            ws2.Cells(j, 5) = "EAN"
            End If

        'Colonne F=6 "Item_name" =>
            ws2.Cells(j, 6) = ws12.Cells(i, 3) & ", " & ws1.Cells(i, 87) & " g "

        'Colonne G = 7 "Manufacturer"
            ws2.Cells(j, 7) = ws1.Cells(i, 7)

        'Colonne H = 8 "recommended_browse_nodes"
            ws2.Cells(j, 8) = ws1.Cells(i, 158)

        'Colonne I= 9 "standard_price" => K=11
            ws2.Cells(j, 9) = ws1.Cells(i, 168)

        'Colonne J = 10 "quantity", réelle
            ws2.Cells(j, 10) = ws1.Cells(i, 122)

        'Colonne K = 11 "Main Image URL"

'            If Range("Q" & i).Value <> "S" Then
            If ws1.Cells(i, 17).Value <> "S" Then
            ws2.Cells(j, 11) = "http://www.france-delicatessen.fr/var/files/1/exim/backup/images/" & ws1.Cells(i, 1) & ".jpg"
            Else
            ws2.Cells(j, 11) = "http://www.france-delicatessen.fr/var/files/2/exim/backup/images/" & ws1.Cells(i, 1) & ".jpg"
            End If

        'Colonne L = 12 "Picture B URL"
            If ws1.Cells(i, 60) <> "" Then
            ws2.Cells(j, 12) = "http://www.france-delicatessen.fr/var/files/1/exim/backup/images/" & ws1.Cells(i, 60)
            Else
            End If

        'Colonne M = 13 "Picture C URL"
            If ws1.Cells(i, 61) <> "" Then
            ws2.Cells(j, 13) = "http://www.france-delicatessen.fr/var/files/1/exim/backup/images/" & ws1.Cells(i, 61)
            Else
            End If

        'Colonne N = 14 "Picture D URL"
            If ws1.Cells(i, 62) <> "" Then
            ws2.Cells(j, 14) = "http://www.france-delicatessen.fr/var/files/1/exim/backup/images/" & ws1.Cells(i, 62)
            Else
            End If

        'Colonne N=14 "fc_shelf_life"
'            ws2.Cells(j, 14) = ws1.Cells(i, 79)

        ' Colonne X = 24 "Update_delete"
            ws2.Cells(j, 24) = Action

        'Colonne Z = 26 "language_value1"
            ws2.Cells(j, 26) = "Nederlands"

        'Colonne AF = 32 "Product_Description"
        'Champ doit être < 500 caractères
           If Len(ws12.Cells(i, 5).Value) > 500 Then
            ws2.Cells(j, 32) = Left(ws12.Cells(i, 5), 450)
            ws2.Cells(j, 32) = ws2.Cells(j, 32) & "...wordt vervolgd ..."
            Else
            ws2.Cells(j, 32) = ws12.Cells(i, 5)
           End If

        'Colonne BE = 57 "bullet_point1"
            If ws1.Cells(i, 11) = "\\PHOTOS & FT FOURNISSEURS\..LOGOS\AOP.jpg" Then
            ws2.Cells(j, 57) = "Gecontroleerde oorsprongsbenaming"
            Else
            End If

        'Colonne BF = 58 "bullet_point2"
            If ws11.Cells(i, 36) = "O" Then
            ws2.Cells(j, 58) = "Glutenvrij"
            Else
            End If

        'Colonne BG = 59 "bullet_point3"
            If ws11.Cells(i, 19) = "O" Then
            ws2.Cells(j, 59) = "Algemene landbouwcompetitie"
            Else
            End If

        'Colonne BH=60 "bullet_point4"
            If ws11.Cells(i, 38) <> "O" Then
            ws2.Cells(j, 60) = "Geen kleurstoffen of conserveringsmiddelen"
            Else
            End If

        'Colonne BI = 61 "bullet_point5"
            If ws11.Cells(i, 15) = "O" Then
            ws2.Cells(j, 61) = "Veganistisch"
            Else
            End If

        'Colonne CF=84 "Directions" OU Use/tasting/precautions
        'Champ doit être < 500 caractères
          If Len(ws12.Cells(i, 7).Value) > 500 Then
            ws2.Cells(j, 84) = Left(ws12.Cells(i, 6), 450)
            ws2.Cells(j, 84) = ws2.Cells(j, 84) & "...wordt vervolgd ...."
            Else
            ws2.Cells(j, 84) = ws12.Cells(i, 5)
          End If

        'Colonne DT = 124 "Speciality 1" - Thèmes Cadeaux et Paniers => CK=89
            If ws1.Cells(j, 136) <> 0 Then
            ws2.Cells(j, 124) = "Geschenken"
            Else
            End If

        'Colonne DU = 125 "Speciality 2" - Thèmes Diététique => CL=90
            If ws1.Cells(i, 141) <> 0 Then
            ws2.Cells(j, 125) = "Dieet, Gezondheid"
            Else
            End If

        'Colonne DV = 126 "Speciality 3" - Thèmes Apéritif => CM=91
            If ws1.Cells(i, 137) <> 0 Then
            ws2.Cells(j, 126) = "Aperitief"
            Else
            End If

        'Colonne DW = 127 "Speciality 4" - Thèmes Spécialité traditionnelle => CN=92
            If ws1.Cells(i, 142) <> 0 Then
            ws2.Cells(j, 127) = "Traditie"
            Else
            End If

        'Colonne DX = 128 "Speciality 5" - Thèmes Produits Festifs => CO=93
            If ws1.Cells(i, 138) <> 0 Then
            ws2.Cells(j, 128) = "Feestelijk product"
            Else
            End If

        'colonne EK = 141 "awards_won1" =>
        'Développer les autres awards de la feuille SEV
            If ws11.Cells(i, 19) <> "" Then
            ws2.Cells(j, 141) = "Toegekend op het Concours Général Agricole " & ws11.Cells(i, 19)
            Else
            End If

        'Colonne EL = 142 "awards_won2"
            If ws11.Cells(i, 9) <> "" Then
            ws2.Cells(j, 142) = "Duurzaam vissen MSC"
            Else
            End If

        'colonne EM = 143 "awards_won3"
            If ws11.Cells(i, 7) <> "" Then
            ws2.Cells(j, 143) = "Rood label"
            Else
            End If

        'colonne EN = 144 "awards_won4"
            If ws11.Cells(i, 38) <> "" Then
            ws2.Cells(j, 144) = "Geen kleurstoffen of conserveringsmiddelen"
            Else
            End If

        'colonne EO = 145 "awards_won5"
            If ws11.Cells(i, 40) <> "" Then
            ws2.Cells(j, 145) = "Ambachtelijk product"
            Else
            End If

        'Colonne FE = 161 "dietary_fiber_per_serving_string" =>
            If ws1.Cells(i, 75) = "" Then
            ws2.Cells(j, 161) = ""
            Else
            ws2.Cells(j, 161) = ws1.Cells(i, 75) & " (g/100g)"
            End If

        'Colonne FT = 176 "primary_ingredient_country_of_origin
            ws2.Cells(j, 176) = "Frankrijk"

        'Colonne FV = 178 "Sel" =>
            ws2.Cells(j, 178) = ws1.Cells(i, 74) & " (g/100g)"

        'Colonne FZ = 182 "serving_size_unit_of_measure" =>
            ws2.Cells(j, 182) = "gram"

        'Colonne GI=191 "subregion_of_origin"
            ws2.Cells(j, 191) = ws1.Cells(i, 18)

        'Colonne GW=205 "energy_content_per_serving_string"
            ws2.Cells(j, 205) = ws1.Cells(i, 70) & " kcal"

        'Colonne GX=206 "Protéïnes" =>
            ws2.Cells(j, 206) = ws1.Cells(i, 73) & " (g/100g)"

        'Colonne GY=207 "serving_size" =>
            ws2.Cells(j, 207) = 100

        'Colonne GZ = 208 "total_carbohydrate_per_serving_string"
            ws2.Cells(j, 208) = ws1.Cells(i, 72) & " Koolhydraten / suiker (g/100g)"

        'Colonne HA = 209 "total_fat_per_serving_string" =>
            ws2.Cells(j, 209) = ws1.Cells(i, 71) & " Vet / vetzuren (g/100g)"

        'Colonne HB = 210 "item_length" =>
            ws2.Cells(j, 210) = ws1.Cells(i, 98)

        'Colonne HC = 211 "item_width" =>
            ws2.Cells(j, 211) = ws1.Cells(i, 99)

        'Colonne HD = 212 "item_height =>
            ws2.Cells(j, 212) = ws1.Cells(i, 100)

        'Colonne HE = 213 "item_dimensions_unit_of_measure"
            ws2.Cells(j, 213) = "CM"

       'Colonne HF=214 "website_shipping_weight" =>
            ws2.Cells(j, 214) = ws1.Cells(i, 96)
            ws2.Cells(j, 214).NumberFormat = "#,##0.00"

        'Colonne HG=215 "website_shipping_weight_unit_of_measure" =>
            ws2.Cells(j, 215) = "KG"

        'Colonne HH=216 "item_display_weight" =>
            ws2.Cells(j, 216) = ws1.Cells(i, 87)

        'Colonne HI=217 "item_display_weight_unit_of_measure" =>
            ws2.Cells(j, 217) = "GR"

        'Colonne HQ = 225 "unit_count"
            ws2.Cells(j, 225) = 1

        'Colonne HS = 227 "unit_count_type"
            ws2.Cells(j, 227) = "Gram"

        'Colonne IK = 245 "country_of_origin"
            ws2.Cells(j, 245) = ws1.Cells(i, 10)

        'Colonne KC = 289 "Item_weight" =>
            ws2.Cells(j, 289) = ws1.Cells(i, 87)

        'Colonne KD = 290 "Item_weight_unit_of_mesure" =>
            ws2.Cells(j, 290) = "GR"

        'Colonne KM=299 "Ingrédients" =>
        'Champ doit être < 500 caractères
          If Len(ws1.Cells(i, 57).Value) > 500 Then
            ws2.Cells(j, 299) = Left(ws12.Cells(i, 9), 450)
            ws2.Cells(j, 299) = ws2.Cells(j, 299) & "...wordt vervolgd ...."
            Else
            ws2.Cells(j, 299) = ws12.Cells(i, 9)
            End If

        'Colonne KZ = 312 "product_tax_code"
            ws2.Cells(j, 312) = "A_FOOD_GEN"

        'Colonne LB = 314 "merchant_shipping_group_name"
            ws2.Cells(j, 314) = "Colissimo"

        'Colonne LF = 318 "currency"
            ws2.Cells(j, 318) = "EUR"

        'Colonne LH = 320 "fulfillment_latency"   'Paramétrer avec l'état du stock
            If ws1.Cells(i, 122) = 0 Then
            ws2.Cells(j, 320) = 5
            Else
            ws2.Cells(j, 320) = 2
            End If

        'Colonne LJ = 322 "item_package_quantity"
            ws2.Cells(j, 322) = 1

        'Colonne LK = 323 "max_aggregate_ship_quantity" =>
            ws2.Cells(j, 323) = 1

        'Colonne LL = 324 "offering_can_be_gift_messaged"
            ws2.Cells(j, 324).NumberFormat = "@"
            ws2.Cells(j, 324) = "Actief"

        'Colonne LM = 325 "offering_can_be_giftwrapped" =>
            ws2.Cells(j, 325).NumberFormat = "@"
            ws2.Cells(j, 325) = "Actief"

        'Colonne LQ = 329 "restock_date"  'ATTENTION: calcul de date de réappro à revoir (date du jour + 7 jours)=>
            ws2.Cells(j, 329) = "2020-09-11"

    ' Enregistrement de la date de création
            ws12.Cells(i, 17) = Now()
            j = j + 1

            Else
'        MAJ Fichier PQ seulement
            ' SKU
            ws3.Cells(k, 1) = ws1.Cells(i, 1)
            ' Prix
            ws3.Cells(k, 2) = ws1.Cells(i, 168)
            'Qty
            ws3.Cells(k, 5) = ws1.Cells(i, 122)
            k = k + 1
        ' Enregistrement de la date de mise à jour
        ws12.Cells(i, 18) = Now()

            End If 'B4
        End If 'B3
    End If 'B2
End If 'B1
  Next i

 'Rangement CIBLE ws2 pour faciliter la lecture
    ws2.Activate
    DLT = ws2.Range("A" & Rows.Count).End(xlUp).Row
    ws2.Range("A4" & ":ZZ" & DLT).Select
     With Selection
    'alignement vertical
    .VerticalAlignment = xlCenter
    'renvoi à la ligne neutralisé
    .WrapText = False
    End With

' Mise en page de la feuille "Amazon"

'    Worksheets("Amazon").Activate
'    Worksheets("Amazon").Range("A:GY").Columns.AutoFit
'    'Worksheets("Amazon").Columns("A:GY").VerticalAlignment = wdAlignVerticalTop
'    Worksheets("Amazon").Columns("H:H").WrapText = False
'    Worksheets("Amazon").Columns("C:C").NumberFormat = "0000000000000"
'    Worksheets("Amazon").Columns("AJ:AJ").NumberFormat = "0.00"
'    Worksheets("Amazon").Columns("M:M").NumberFormat = "0.00"
'    Worksheets("Amazon").Columns("W:W").NumberFormat = "YYYY-MM-DD"
'    With Range("AJ1").CurrentRegion
'    For i = 4 To 1500 ' .cells(i,"D")="'" & frormat(.cells(i,"D"),"#0.00")' pour mémoire sur forum
'    .Cells(i, "AJ") = "'" & Format(.Cells(i, "AJ"), "#0.00")
'    Next i
'    End With
'    With Range("AH1").CurrentRegion
'    For i = 4 To 1500
'    .Cells(i, "AH") = "'" & Format(.Cells(i, "AH"), "#0.00")
'    .Cells(i, "M") = "'" & Format(.Cells(i, "M"), "#0.00")
'    Next i
'    End With

'Création du fichier FFFBN daté qui sera à charger sur Amazon, éventuellement après conversion en .txt.
'On enregistre le fichier xlsm qui va être sauvegardé sous le répertoire de Transferts de la base de données

'Fichier de MAJ des produits nouveaux
    With wb2 'Fichier de MAJ des produits nouveaux
    .SaveCopyAs "\\PARTENAIRES MD\INTERNET\MARKET PLACE\AMAZON\Fichier Exportés AMZ\Fichiers chargés\NL\FFFB_NL-" & version & "-" & name & "-" & Format(Now(), "mmdd-hhmm") & ".xlsm"
    DoEvents
    ' Je veux refermer le modèle sans le contenu, vierge donc
    .Close savechanges:=False
End With

'FICHIER DE MAJ PQS ws3:
ws3.Activate
    ws3.Rows("2:5000").Select 'Rangement des colonnes 2 à 5000
    With Selection
        'alignement vertical
        .VerticalAlignment = xlCenter
        'renvoi à la ligne neutralisé
        .WrapText = False
        'hauteur de ligne 15
        .RowHeight = 15
        'Centrage des colonnes 2 à 4
    End With
    ws3.Range("B:E").HorizontalAlignment = xlCenter

With wb3
    .SaveCopyAs "\\PARTENAIRES MD\INTERNET\MARKET PLACE\AMAZON\Fichier Exportés AMZ\Fichiers chargés\MAJ Fichiers prix et quantités\MAJ_NL_PQ-" & version & "-" & name & "-" & Format(Now(), "mmdd-hhmm") & ".xlsm"
    DoEvents
    'Refermer le modèle sans le contenu, vierge donc
    .Close savechanges:=False
End With

With ws1 'Sauvegarde la BDD
'    ws1.Copy
    sNomSauv = sNomSauvor & " après ImportS AMZ du " & Format(Now(), "mmdd-hhmm") & ".xlsm" 'création du nouveau nom
    ThisWorkbook.SaveAs sPath & sNomSauv
'    ThisWorkbook.SaveAs "\\BDD\GRANDE BASE APRES Imports PQ du " & Format(Now(), "mmdd-hhmm") & ".xlsm"
    DoEvents
'    ws1.Activate
'    ActiveWorkbook.Close savechanges:=True
 End With

End Sub

Qu'en pensez vous ? comment gagner du temps..en évitant deja les gros pièges ?

Merci

Bonjour,

Je n'ai pas de solution pour accélérer ton code à par Application.ScreenUpdating = False à placer au début du code > sous les Dim ...

Par contre, j'aurais des suggestions afin de réduire un peu le texte du code ...

Au lieu de :

'Colonne BE = 57 "bullet_point1"
If ws1.Cells(i, 11) = "\\PHOTOS & FT FOURNISSEURS\..LOGOS\AOP.jpg" Then
    ws2.Cells(j, 57) = "Gecontroleerde oorsprongsbenaming"
    Else
    End If

Écrire :

'Colonne BE = 57 "bullet_point1"
If ws1.Cells(i, 11) = "\\PHOTOS & FT FOURNISSEURS\..LOGOS\AOP.jpg" Then _
               ws2.Cells(j, 57) = "Gecontroleerde oorsprongsbenaming"

Au lieu de :

'Colonne BF = 58 "bullet_point2"
If ws11.Cells(i, 36) = "O" Then
ws2.Cells(j, 58) = "Glutenvrij"
Else
End If

Écrire :

'Colonne BF = 58 "bullet_point2"
If ws11.Cells(i, 36) = "O" Then ws2.Cells(j, 58) = "Glutenvrij"

ric

Bonsoir Eric

D'abord merci d'avoir vu ça, effectivement, c'est totalement inutile de gaspiller son temps sur le rafraichiseement.

Peut être d'autant plus que le fichier est sur serveur et que l'excel est en local: c'est pas une piste ça ?

donc j'applique ça deja.

Moi ce que je me demandais en terme de temps de calcul; c'est si la manière de boucler était bonne, voir si la trsucture du fichier source était bonne.

a cause des traductions, je crée maintenant des feuilles; depuis l'apparition du Hollandais.

Avant tout était sur la même feuille mais tu imagines que ds tu as réservé 3 colonnes pour tes trois langues de base pour une data et qu'en arrive une autre (langue), toutes les cellules à droite perdent leurs références et les formules et les codes qui vont avec..

D'ou l'idée de mettre les données similaires par langues sur des feuilles "langues".

tu vois c'est une question d'orga de fichier:

- tout décaler génère un risque d'erreur ds les réfences de position des données => gros travail

- créer une structure de données par langue permet de multiuplier les langues, MAIS je pense que le temps de calcul est pire !

Je te dis deux heures après le lancement ça tournait toujours avec mon i5,Excel sur un SSD 500 et 32 Go de Ram sou sW10 Pro.

En résumé:

1 - Application.ScreenUpdating = False; ça se met bien sur avant le End sub ?

2 - Mettre en copie le fichier de travail et donc son code sur SSD, puis le recopier à son emplacement sur le serveur, UN NAS synology dont je ne connais pas trop le temps d'accès ?

3 - Structure des feuilles par langue ou pas ?

4- Types ou regroupement des boucles; finalement qu'est ce qui est long: se dplacer ds une cellule ou faire de nombreux calculs autour d'une même cellile et ça, ça toucherai la structure du code ?

Bonjour,

comme tu parles de serveur, il faut vraiment que tu copies ces fichiers en local et que tu travailles sur ces copies.

Ou au moins que tu apprennes à travailler en mettant une plage entière dans dans une variable tableau en une fois, que tu travailles sur ce tableau en mémoire, pour au final l'inscrire en une fois dans le fichier.
Travailler cellule par cellule est 100 fois plus lent, et en plus tu rajoutes des accès serveur à chaque lecture ou écriture..
Bon pour la sieste oui ;-)
eric

Salut Polygos,
Salut Ric, Eriiic,

Eriiic a mille fois raison de préconiser le travail en tableaux : tu ne devrais plus avoir le temps d'aller dormir !
Par contre, je veux bien un exemple des deux fichiers cibles vierges et quelques centaines de lignes de ta source 'Epicerie' (neutralisée de ses données sensibles, blabla...), histoire de tâter leur structure et de ne pas devoir réinventer leur look (en têtes, positionnement, couleurs,...)
Ainsi, je copie les résultats sur de nouvelles feuilles de ta source et en crée des fichiers : plus besoin de les charger depuis ton serveur.

Á toi de voir...

A+

Bonjour curulis : cela me rappelle cette super expérience vécue ensemble https://forum.excel-pratique.com/excel/trier-un-tableau-sur-vba-130995/3 où l'on est passé de quelques heures de traitement à quelques secondes.

Je cautionne donc tout à fait ce que dit eriiiiic que je salue sur le fait d'importer tes données dans un array

Salut Steelson,

Dico avait gagné la bataille haut la main... et je n'ai toujours pas digéré ce monstre.
Je ne sais par où le prendre alors, je peaufine mes tableaux le mieux possible.

Dans ce cas-ci, il me semble, à la lecture du code de Polygos, qu'on peut éviter le téléchargement des fichiers vierges et les créer directement dans le fichier source.
Quelques tableaux et... Dico de ta part, sans doute ? 2500 lignes plutôt que 150.000 de l'époque : de la roupie de sansonnet !

A+, on the road again...

Bonsoir Curulis

encore une bonne idée effectivement: insérer les feuilles cibles dans le fichier source

et je retiens aussi, les tableaux mais là, j'avoue que je ne maitrise pas, d'autant que mes données ne sont pas continues et de loin, dans la feuille source. Un post accessible pour les newbees peut être ? toi qui connais bien le forum ?

Je retiens en outre la délocalisation du serveur.

Merci les gars

Salut Polygos,
Salut les as,

et donc, Polygos ? Ces fichiers-modèles et tant qu'à faire, un échantillon réel (avec ses difficultés, apparemment!) de ton fichier-source ?
Question :
Tes fichiers-cibles ou source subissent-ils de temps à autre une mise à jour du nombre de données à inclure dans le calcul ?

Si oui, il conviendrait déjà de le savoir et dans ce cas, de s'assurer de la concordance ABSOLUE entre les en-têtes de colonne des uns et des autres...

Á te lire,

A+