Comment dire? macro trop longue et

Version imprimable

Voir 40 message(s) de cette discussion en une page

09/04/2015, 09h39
Adamas2008

1 pièce(s) jointe(s)

Comment dire? macro trop longue et

Bonjour, mon problème, lorsque je lance la macro pour mettre à jour les données elle scanne à chaque fois toute la feuille et ça prends beaucoup de temps.
D'autre part j'ai du créer 4 boutons car la formule est trop longue :
il y a environ 200 noms a trouver dans la feuille et recopier certaines ligne sur une autre feuille attribuée pour chaque personne...
-Comment simplifier ma formule pour n'avoir plus qu'un seul bouton
-Comment éviter que la macro scanne depuis le début alors que 2 semaines avant la date de dernière modification suffirait

En pièce jointe on voit la feuille avec toutes les interventions et les contrôles (RECOP / RECOP / BOUTON...) ou je clic pour scanner cette feuille et extraire pour chaque chirurgien les données qui m'intéressent.

Je ne sais pas si je suis clair, mes connaissances en VBA étant très limitées.
Merci
Laurent:?
09/04/2015, 10h20
uxorialrook8
Bonjour,

Je vais essayer de répondre au mieux avec ce que j'ai pu comprendre :).

Pour ta première question, tu peux appeler une Sub() avec le bouton que tu souhaites et ensuite à la fin de cette dernière appeler la 2ème,3ème,4ème... pour n'avoir qu'un déclencheur (ton bouton) mais 4 Sub pour séparer ton code trop long sinon.
Pour appeler une méthode depuis une autre tu utilises la fonction Call. Je t'ai mis un petit exemple ci-dessous:
Code:

1 2 3 4 5 6 7 Sub number1() Call number2 End Sub Sub number2() End Sub
Pour ta 2ème question: Si tu connais la date de chaque élément, tu peux faire un test en la comparant avec la date du jour. Si la différence est de moins de 2 semaine, tu scan sinon tu passes au suivant.

J'espère avoir pu répondre à ta question :)
09/04/2015, 14h52
parmi

Bonjour,

À voir le bout de ton code, tu sembles faire une boucle pour chaque médecin.
S'il y en a 200, ça fait 200 boucles...

Tu pourrais créer une feuille avec tous les noms de médecins en colonne A et le nom de leur feuille en colonne B.

Dans une seule boucle sur ta colonne de noms, tu recherches le nom de la feuille du médecin inscrit sur cette ligne et tu copies les données avec une 2e boucle plutôt que de mettre x lignes de codes qui sont à peu près identiques.

Pour les dates, tu pourrais faire un filtre avec une plage de dates et ne lire que les lignes visibles (SpecialCells(xlCellTypeVisible))

Tu écris

Citation:

D'autre part j'ai du créer 4 boutons car la formule est trop longue :
il y a environ 200 noms a trouver dans la feuille et recopier certaines ligne sur une autre feuille attribuée pour chaque personne...

Je ne saisis pas ce que tu entends par Formule...
Et on ne sait pas quelle est la condition pour copier ou non une ligne de données...

Peut-être que j'ai mal compris la problématique, par contre... (?)
10/04/2015, 07h30
Adamas2008

Merci pour les réponses.
Parmi, oui je fais autant de boucle que de médecin, j'ai une feuille avec le programme de tous les jours et ensuite chaque médecin a une feuille.
la macro cherche le noms des médecins sur la feuille de programme et copie ces lignes sur la feuille de chaque médecin.(le noms de l'intervention, sexe du patient, année, date opération...)
Je comprends ta solution mais pourrais-tu me faire un exemple car cela est hors de mes compétences.
Ce que j'entends par formule c'est en fait le code de ma macro qui justement est une boucle reproduite x fois.
Laurent

Les feuilles de tes médecins sont des modèles où tu remplis des champs fixes ou plutôt un genre d'historique où tu copies des données à la fin ?

Dans une feuille que tu nommes Liste, tu inscris tous les noms de médecins (tels qu'ils sont écrits dans la feuille BASE) en colonne A.
En colonne B, tu inscris le nom de la feuille qui le représente.

Ça pourrait ressembler à ceci. J'ai assumé que tu copiais les données à la suite d'autres.

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
Sub RECOPIE()
    Dim I As Long, J As Long
    Dim nbLignes As Long    'nombre de lignes de la feuille de données
    Dim Ligne As Long       'première ligne vide de l'onglet des médecins
    Dim Feuille As String   'Nom de la feuille du médecin en cours
 
    With Sheets("BASE")
        nbLignes = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
 
    For I = 2 To nbLignes
        Feuille = GetNomFeuille(Range("A" & I)) 'en assumant que le nom du médecin est en colonne A
        Ligne = Sheets(Feuille).Cells(Rows.Count, "A").End(xlUp).Row + 1 'première ligne vide
        For J = 1 To 13
            Sheets(Feuille).Cells(Ligne, J) = Sheets("BASE").Cells(I, J)
        Next
    Next
End Sub
 
Function GetNomFeuille(Nom As String) As String
    Dim I As Long, nbLignes As Long
 
    nbLignes = Sheets("Liste").Cells(Rows.Count, "A").End(xlUp).Row
    For I = 1 To nbLignes
        If Sheets("Liste").Range("A" & I) = Nom Then
            GetNomFeuille = Sheets("Liste").Range("B" & I)
            Exit Function
        End If
    Next
End Function

12/04/2015, 15h25
joe.levrai

Bonjour,

n'ayant pas vu ton fichier, je propose cette solution si tu penses qu'elle sera compatible avec tes données et ton usage :

- une feuille qui sera une base de données
- une feuille "modèle" dans laquelle on peut interroger 1 médecin, et ça rempli le modèle

ça t'évite les 200 feuilles, et tu facilement upgrader ton fichier pour saisir des nouvelles données (médecins, soins etc...) ou faire des requêtes dans ta base

je veux bien y jeter un oeil à ton fichier, mais va falloir le rendre "non secret médical" compatible (même si personnellement j'y suis assujeti à ce secret médical)
13/04/2015, 10h40
Adamas2008

1 pièce(s) jointe(s)

VOICI LE FICHIER EXCEL ANONYME

Bon, comme je suis perdu, je vous joint le fichier Excel que j'ai rendu anonyme. Ce sera plus simple.
La feuille "Base" est celle qui est remplie chaque jour (copié / collé du programme opératoire)
Une feuille pour chaque chirurgien
Quand je clic sur "Commande bouton 21" :
la fonction scan la feuille "Base" et recopie sur la feuille de chaque chirurgien L'intervention, sexe, age, date ...

Mes 2 problèmes :
- la fonction est circulaire et pour scanner jusqu'à 4000 interventions sur la feuille Base et recopier sur 200 feuilles de chirurgien c'est extrêmement long.
J'ai du d'ailleurs créer 4 "boutons" car la fonction est trop longue.
- A chaque fois que je mets à jour, la fonction re-scanne depuis le début alors que c'est inutile.

Voilà en espérant être plus clair...8O
Laurent

Dans le code de ton bouton, mets RECOPIE et efface le reste
Et copie ce code en-dessous

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Sub RECOPIE()
    Dim I As Long, J As Long
    Dim nbLignes As Long    'nombre de lignes de la feuille de données
    Dim Ligne As Long       'première ligne vide de l'onglet des médecins
    Dim Feuille As String   'Nom de la feuille du médecin en cours
 
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
 
    With Sheets("BASE")
        nbLignes = .Cells(.Rows.Count, "A").End(xlUp).Row
    End With
 
    For I = 5 To nbLignes
        Feuille = GetNomFeuille(Sheets("BASE").Range("C" & I)) 'en assumant que le nom du médecin est en colonne A
        If Feuille <> "" Then
            Ligne = Sheets(Feuille).Cells(Rows.Count, "A").End(xlUp).Row + 1 'première ligne vide
            'Copie des données de colonne A à M
            Sheets("BASE").Range(Cells(I, 1), Cells(I, 13)).Copy
                Sheets(Feuille).Cells(Ligne, 1).PasteSpecial xlPasteValues
        End If
    Next
 
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
 
    MsgBox "Terminé"
End Sub
 
Function GetNomFeuille(Nom As String) As String
    Dim I As Long, nbLignes As Long
 
    nbLignes = Sheets("Liste").Cells(Rows.Count, "A").End(xlUp).Row
    For I = 1 To nbLignes
        If Sheets("Liste").Range("A" & I) = Nom Then
            GetNomFeuille = Sheets("Liste").Range("B" & I)
            Exit Function
        End If
    Next
End Function

Il faudrait aussi une validation des noms de feuilles et autres, mais ça fonctionne comme ceci et ça me prend environ 20 secondes à rouler..

13/04/2015, 15h54
parmi

Et pour ce qui est de ne pas recommencer depuis le début, soit tu mets un "X", disons, quand la ligne est copiée (dans BASE) et tu ne les considères plus quand tu repasses les fois suivantes, soit tu vérifies (plus long) que la ligne n'a pas été copiée en bouclant les lignes de chaque feuille au fur et à mesure...
13/04/2015, 17h18
joe.levrai

Bonjour,

j'ai jeté un œil à ton fichier et il y aurait vraiment pas mal de boulot pour convertir ton fichier en format BDD 8O Beaucoup plus de temps que je ne puis m'en accorder pour cela

je laisse les autres contributeurs continuer sur l'amélioration de tes boucles, et suis vraiment désolé de ne pouvoir poursuivre.

heu

Bonjour
il y a des constantes dans ton fonctionnement

a chaque fois on choisi les même cellule

pour le médecin

Code:

Cells(L, 3)

pour la repartition idem pour chaque médecin

Code:

1
2
LigneSup = Range("A65536").End(xlUp).Row
Lig1 = 1: Lig2 = 1: Lig3 = 1

et enfin la répartition identique a chaque médecin

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
.Cells(Lig2, 1) = Sheets("BASE").Cells(L, 1)
            '.Cells(Lig2, 2) = Sheets("BASE").Cells(L, 2)
            '.Cells(Lig2, 3) = Sheets("BASE").Cells(L, 3)
            .Cells(Lig2, 4) = Sheets("BASE").Cells(L, 4)
            .Cells(Lig2, 5) = Sheets("BASE").Cells(L, 5)
            .Cells(Lig2, 6) = Sheets("BASE").Cells(L, 6)
            .Cells(Lig2, 7) = Sheets("BASE").Cells(L, 7)
            .Cells(Lig2, 8) = Sheets("BASE").Cells(L, 8)
            .Cells(Lig2, 9) = Sheets("BASE").Cells(L, 9)
            .Cells(Lig2, 10) = Sheets("BASE").Cells(L, 10)
            .Cells(Lig2, 11) = Sheets("BASE").Cells(L, 11)
            .Cells(Lig2, 12) = Sheets("BASE").Cells(L, 12)
            .Cells(Lig2, 13) = Sheets("BASE").Cells(L, 13)

alors pour moi c'est simple et on en fait qu'une
on vire tes select case
et le nom pris dans cells(L,3) devient le nom du sheets
comme ceci:

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Private Sub CommandButton21_Click()
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets("BASE").Select
'Dim LigneSup, L As Currency, Lig1 As Currency, Lig2 As Currency, Lig3 As Currency
LigneSup = Range("A65536").End(xlUp).Row
Lig1 = 1: Lig2 = 1: Lig3 = 1
For L = 2 To LigneSup 'NOMBRE DE COLONNES SELECTIONNEES
 
 nom = Trim(Split(Cells(L, 3), " ")(1))
        Lig2 = Lig2 + 1
        With Sheets(nom)
                   for e=1 to 13
           .Cells(Lig2, e) = Sheets("BASE").Cells(L, e)
           next       
        End With
 Next L
end sub

et basta

re

j'ai fait une erreur en voulant garder to system lig2,lig2,lig3

dans une seul boucle la dernière ligne utilisé doit être mis a jour a chaque tour de boucle

essaie plutôt ca !

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Private Sub CommandButton21_Click()
Dim LigneSup, derlig
    ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
    Sheets("BASE").Select
        LigneSup = Range("A65536").End(xlUp).Row
    For L = 2 To LigneSup    'NOMBRE DE COLONNES SELECTIONNEES
        nom = Trim(Split(Cells(L, 3), " ")(1))
        With Sheets(nom)
            derlig = .Cells(Rows.Count, 1).en(xlUp).Row + 1
            For e = 1 To 13
                .Cells(derlig, e) = Sheets("BASE").Cells(L, e)
            Next
        End With
    Next L
End Sub

et on pourrait même accélérer la chose en utilisant des variables tableaux

13/04/2015, 21h37
joe.levrai
hey caliméro, t'as oublié ta coquille à la ligne 9 :ptdr:
Code:

1 2 derlig = .Cells(Rows.Count, 1).end(xlUp).Row + 1
je te met quand même +1 parceque j'ai passé mon tour sur ce sujet ... et qu'en échange j'ai traité un autre sujet avec un petit mondico que tu affectionnes tant :mrgreen:
13/04/2015, 22h56
parmi

Il ne faut pas oublier que le nom des feuilles ne correspond pas au nom du médecin en colonne 3, de là la feuille Liste que je lui ai dit de rajouter pour créer la correspondance... ;)
13/04/2015, 23h08
patricktoulon

re

joe:
puré de coquille

j'ai un clavier sans fil et si je tape trop vite il me saute des touches

enfin bref le tout c'est que la mécanique est bonne

et oui on pourrait aussi traiter ca avec un dico et même le tout dans un tableau en mémoire plutôt que de boucler sur les cellules ,mais bon
je ne suis pas sur qu'il sache gérer ce genre de méthode vu son code original

parmi a quoi bon ajouter une fiche liste

Code:

trim(split(cells(l,3)(1))

donne le nom du médecin

si ca n'est pas le cas ca veut dire que les ligne en colonne 3 donne plusieurs orthographe pour le même médecin , au quel cas il serait judicieux avant quoi que se soit de régler ce problème
13/04/2015, 23h22
parmi

Avec les noms qu'on voit, ta méthode fonctionne.
Mais s'il y a des noms composés de plusieurs mots, comment va-t-il appeler son onglet ?
14/04/2015, 08h05
Adamas2008

1 pièce(s) jointe(s)

j'ai donc copié la formule et voici ce qui ce passePièce jointe 1746998O
Laurent
14/04/2015, 08h06
Adamas2008

1 pièce(s) jointe(s)

Pièce jointe 174700
14/04/2015, 10h31
patricktoulon

re

re

mille excuse tu a raison mais en fait c'est un peu le foutoir dans ton fichier

dans la colonne 3 il y a les noms

et même des chiffre 0 par exemple ou même le mot "chirurgien" qui n'est pas un nom
alors effectivement le split donne une erreur puisque il n'y a pas d'espaces

je vais regarder a trouver une solution ;)
14/04/2015, 11h01
patricktoulon

re

bon c'était tou bete

en fait j'ai respecter ton debut et ta fin de boucle

hors les lignes commencent en ligne 5
c'est ce qui explique pourquoi j'avais "chirurgien " et le chiffre 0

donc se sera

Code:

For L = 5 To LigneSup 'NOMBRE DE COLONNES SELECTIONNEES

une question cependant ce fichier comment est il créé par une requête ou par une personne ???

Voir 40 message(s) de cette discussion en une page