Evitez les active/select dans le cadre d'une copie de données fichier vers fichier

[Blueman]

Bonjour à tous,

Dans le cadre de mon travail, je suis amené à exploiter un fichier de données quotidiennement. J'extraie des valeurs (OK/PAS OK/"") que je converti en conforme/non conforme que je stocke dans une base de données pour conserver un petit historique des jours précédents.

Actuellement, mon code très moche est construit sur ce modèle. J'utilise des active/select, ce qui alourdit le procédé, sachant que j'ai 150 points à parcourir. J'utilise cette méthode car mon fichier d'origine change d'un jour à l'autre. A chaque fois qu'un relevé PAS OK est fait, j'ai une ligne qui s'intercalle avec le format classique pour expliqué la non conformité. Je n'ai pas à traiter ces lignes intermédiaires dans ma base, mais je cherche à expliquer par là pourquoi je ne fais pas des copies directes d'une cellule à l'autre.

Mon principal souci se passe au niveau du décalage de colonne entre mes différents points. La ligne de recopie (ligne active dans le programme) est déterminée par une variable NumLigneBDD que j'ai défini au préalable.

        Workbooks("ronde Four").Activate
        Range("A6").Activate
        col = 3
        
        'Cloches
        
        
            'Niveau cloche équilibrage
            While ActiveCell.Value <> "Niveau cloche équilibrage"
                ActiveCell.Offset(1, 0).Select
            Wend
            valeur = ActiveCell.Value
            ActiveCell.Offset(0, -2).Select
            'Recopie des données
            Select Case valeur
                Case "OK"
                    valeur = "C"
                Case "PAS OK"
                    valeur = "NC"
                Case ""
                    valeur = "V"
            End Select
            Workbooks("BDD Four").Worksheets("Four BDD").Activate
            ActiveCell.Offset(0, col).Value = valeur
            Workbooks("ronde Four").Activate
            col = col + 1
            valeur = ""            

            'Niveau cloche régulation
            While ActiveCell.Value <> "Niveau cloche régulation"
            ...

Voilà, si vous avez des pistes pour m'aider à avancer, je suis preneur. Sinon, je continuerai ainsi, sachant que ca marche bien même avec une brouette pour PC

 

[Gorfael]

Re : Evitez les active/select dans le cadre d'une copie de données fichier vers fichi

Salut Blueman et le forum

Actuellement, mon code très moche

C'est possible, mais comme on en a qu'un lambeau, pas facile de le corriger, ce qu'on pourrait modifier pouvant avoir des répercutions sur tout le code.

            'Niveau cloche équilibrage
            While ActiveCell.Value <> "Niveau cloche équilibrage"
                ActiveCell.Offset(1, 0).Select
            Wend

Si je décode bien, tu recherche la cellule de la colonne A (à partir de A6) qui contient le texte "Niveau cloche équilibrage".
Moi, j'utiliserai plutôt un Find

Dim Cel as range
'....
set cel=range([A6],cells(Rows.count,"A").end(xlup)).Find ("Niveau cloche équilibrage")
If cel is nothing then exit sub

Évidemment, je prévois une sortie directe si la valeur n'est pas trouvée.
A+

 

[Blueman]

Re : Evitez les active/select dans le cadre d'une copie de données fichier vers fichi

Merci Gorfael de la réponse, je vais essayer les find pour voir un peu ce que ca donne

Je disais que mon code était moche dans le sens que j'utilisais beaucoup de select et d'activate, ce qui fais ralentir considérablement le traitement.

Pour l'accélérer, je suis parti ce matin sur des copies directes de wbk à wbk (dans mon exemple, je suis sur mon fichier de test, donc j'ai regroupé mes onglets dans wbk1). Et à priori le traitement se fait immédiatement, grosse avancée.

Par contre, comme tu le dis, je n'ai pas du tout prévu de sortie, et il va falloir que je m'y attele avant de tout planter. Et l'avantage de ta formule, c'est que si par accident, j'ai une ligne qui a sauté, je ne me retrouve pas en 65000 et des...

Merci donc pour ce petit conseil, au plaisir de te relire.

Ci dessous un petit apercu de mon code si ca peut servir à quelqu'un.

Sub BDD()

    
    
    Dim nom As String
    Dim heure As String
    Dim valeur As String
    Dim VN As Double
    Dim dateronde As Date
    Dim poste As Integer
    Dim NumLigneBDD As Integer
    Dim col As Integer
    Dim ligne As Integer
    Dim FLL As Integer
    Dim FLLVal As String
    Dim Wbk1 As Workbook, Wbk2 As Workbook
    
    
    'Deconcaténation du nom du rondier et de la date
    Application.DisplayAlerts = False
    Range("A2").UnMerge
    Range("A2").Select
    Selection.TextToColumns Destination:=Range("A2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=True, Other:=False, FieldInfo _
        :=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1)), TrailingMinusNumbers:= _
        True
    Range("A3").UnMerge
    Range("A3").Select
    Selection.TextToColumns Destination:=Range("A3"), DataType:=xlFixedWidth, _
        FieldInfo:=Array(Array(0, 1), Array(10, 1), Array(13, 1), Array(19, 1), Array(21, 4), _
        Array(32, 1)), TrailingMinusNumbers:=True
    Application.DisplayAlerts = True
    
    'Nom de l'agent en C2
    'Date de la ronde en E3
    'Heure de début en F3
    
    
'Sauvegarde du nom du rondier avec la forme majuscule de début puis minuscules

    Range("E2").Value = "=PROPER(R[0]C[-2])"
    nom = Range("E2").Value & " " & Range("D2").Value

'Sauvegarde de l'heure dans la variable associée
    
    heure = Format(Range("F3").Value, "HH:MM:SS")

'Sauvegarde de la date dans la variable associée

    dateronde = Range("E3").Value

'Recherche du poste concerné
    
    Select Case Hour(heure)
        Case 0 To 5
            poste = 3
            dateronde = dateronde - 1
        Case 6 To 13
            poste = 1
        Case 14 To 21
            poste = 2
        Case 22 To 23
            poste = 3

    End Select
    
    
    
'Préparation de la base de données
    Set Wbk1 = ThisWorkbook
    NumLigneBDD = 5
    While Wbk1.Worksheets(3).Cells(NumLigneBDD, 1) <> dateronde
        NumLigneBDD = NumLigneBDD + 3
    Wend
    While Wbk1.Worksheets(3).Cells(NumLigneBDD, 2) <> poste
        NumLigneBDD = NumLigneBDD + 1
    Wend
    FLL = 5
    
'Copie des données dans la base de données

    ligne = 7
    While Wbk1.Worksheets(1).Cells(FLL, 1) <> ""
        FLLVal = Wbk1.Worksheets(1).Cells(FLL, 1).Value
        While Wbk1.Worksheets(2).Cells(ligne, 1).Value <> FLLVal
            ligne = ligne + 1
        Wend
        col = 3 + Wbk1.Worksheets(1).Cells(FLL, 2).Value
        'test pour retrouver les valeurs numérique
        If IsNumeric(Wbk1.Worksheets(2).Cells(ligne, 3).Value) Then
            'c'est numérique
        Else
            valeur = Wbk1.Worksheets(2).Cells(ligne, 3).Value
            Select Case valeur
                Case "OK"
                    valeur = "C"
                Case "FAIT"
                    valeur = "C"
                Case "PAS OK"
                    valeur = "NC"
                Case "PAS FAIT"
                    valeur = "NC"
                Case ""
                    valeur = "V"
            End Select
            Wbk1.Worksheets(3).Cells(NumLigneBDD, col).Value = valeur
            col = col + 1
        End If
        FLL = FLL + 1
    Wend