Afficher des plages de cotations sous conditions

Afficher des plages de cotations sous conditions Afficher une plage de donnée avec plusieurs conditions » Forum - Bureautique Faire afficher un message d'erreur sur conditions en heure [Résolu] (Résolu) » Forum - Excel Afficher une plage de données à partir d'une liste déroulante (Résolu) » Forum - Excel Afficher une plage de données à partir d'une liste déroulante (Résolu) » Forum - Excel Transfert de plusieurs plages de données avec condition (Résolu) » Forum - VB / VBA

Bonjour,
je n arrive toujours pas a solutionner ce casse tète
j ai une macro qui m affiche plusieurs plages vers 2 graphes sous condition
cette macro s’exécute par Bouton; elle fonctionne parfaitement ; mais je voudrais qu elle s’exécute automatiquement d 'elle même je mets le code en dessous
j ai vu que certains font tourner en boucle une macro qui copie les formule et le format sous condition et qui balaie en même temps chaque fois que la condition change ,ce n 'est pas exactement ce que je voulais faire,mais si il n ya pas d 'autres solution alors j adopterais celle ci
je mets le code en dessous de ma macro actuelle (je désire qu elle s’exécute automatiquement)
Merci de votre aide

Option Compare Text
Private Sub linkrg(target As Range, source As Range)
source.Copy
target.Parent.Activate
target.Select
target.Parent.Paste link:=True
Application.CutCopyMode = False
End Sub
Sub RecopiePlage()

Application.ScreenUpdating = True


If [AX101] = "Ok" Then
Call linkrg([CK11:CS51], [BA101:BI141])
ElseIf [AX144] = "Ok" Then
Call linkrg([CK11:CS51], [BA144:BI184])
ElseIf [AX187] = "Ok" Then
Call linkrg([CK11:CS51], [BA187:BI227])
ElseIf [AX230] = "Ok" Then
Call linkrg([CK11:CS51], [BA230:BI270])
ElseIf [AX273] = "Ok" Then
Call linkrg([CK11:CS51], [BA273:BI313])
End If
If [BZ101] = "Ok" Then
Call linkrg([DB11:DJ51], [BO101:BW141])
ElseIf [BZ144] = "Ok" Then
Call linkrg([DB11:DJ51], [BO144:BW184])
ElseIf [BZ187] = "Ok" Then
Call linkrg([DB11:DJ51], [BO187:BW227])
ElseIf [BZ230] = "Ok" Then
Call linkrg([DB11:DJ51], [BO230:BW270])
ElseIf [BZ273] = "Ok" Then
Call linkrg([DB11:DJ51], [BO273:BW313])
End If
If [AX316] = "Ok" Then
Call linkrg([CK57:CS97], [BA316:BI356])
ElseIf [AX359] = "Ok" Then
Call linkrg([CK57:CS97], [BA359:BI399])
ElseIf [AX402] = "Ok" Then
Call linkrg([CK57:CS97], [BA402:BI442])
ElseIf [AX445] = "Ok" Then
Call linkrg([CK57:CS97], [BA445:BI485])
ElseIf [AX488] = "Ok" Then
Call linkrg([CK57:CS97], [BA488:BI528])
End If
If [BZ316] = "Ok" Then
Call linkrg([DB57:DJ97], [BO316:BW356])
ElseIf [BZ359] = "Ok" Then
Call linkrg([DB57:DJ97], [BO359:BW399])
ElseIf [BZ402] = "Ok" Then
Call linkrg([DB57:DJ97], [BO402:BW442])
ElseIf [BZ445] = "Ok" Then
Call linkrg([DB57:DJ97], [BO445:BW485])
ElseIf [BZ488] = "Ok" Then
Call linkrg([DB57:DJ97], [BO488:BW528])
End If
Cells(12, 1).Activate
ActiveWindow.ScrollRow = ActiveCell.Row
End Sub



Forum

Afficher des plages de cotations sous conditions Afficher une plage de donnée avec plusieurs conditions » Forum - Bureautique Faire afficher un message d'erreur sur conditions en heure [Résolu] (Résolu) » Forum - Excel Afficher une plage de données à partir d'une liste déroulante (Résolu) » Forum - Excel Afficher une plage de données à partir d'une liste déroulante (Résolu) » Forum - Excel Transfert de plusieurs plages de données avec condition (Résolu) » Forum - VB / VBA

Web: www.shapebootstrap.net

49 réponses

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

Bonjour,

a priori tu n'as besoin d'exécuter ta macro que si tu changes des données dans ta feuille alors avec cette macro tu n'auras plus besoin de bouton :

Private Sub Worksheet_Change(ByVal Target As Range) If Not Intersect(Target, [BA101:BW528]) Is Nothing Then Call RecopiePlage End Sub 

Bien sûr tu peux adapter en précisant avec Intersect les plages concernées.

Reply
réponses:
  • auteur

    Bonjour
    et merci de t être intéressé a mon soucis

    Avant tout je dois te dire que je ne suis absolument pas programmeur
    les "OK" changent d'eux même suivant les critères que j ai mis par formule dans les cellules
    donc je ne vois pas très bien ou je peux mettre ce que tu m 'écrits et de quelle manière..???? peux tu être plus précis par rapporta mon code

  • gbinforme

    Re
    Si tes changements se font en fonction de formules, il faut utiliser ceci :

    Private Sub Worksheet_Calculate()     Call RecopiePlage End Sub 

    Tu copies ce codes dans ta feuille concernée (mode d'emploi)

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

Comme ceci????

Private Sub Worksheet_Calculate()
Call RecopiePlage

If [AX101] = "Ok" Then
Call linkrg([CK11:CS51], [BA101:BI141])
ElseIf [AX144] = "Ok" Then
Call linkrg([CK11:CS51], [BA144:BI184])
ElseIf [AX187] = "Ok" Then
Call linkrg([CK11:CS51], [BA187:BI227])
ElseIf [AX230] = "Ok" Then
Call linkrg([CK11:CS51], [BA230:BI270])
ElseIf [AX273] = "Ok" Then
Call linkrg([CK11:CS51], [BA273:BI313])
End If
If [BZ101] = "Ok" Then
Call linkrg([DB11:DJ51], [BO101:BW141])
ElseIf [BZ144] = "Ok" Then
Call linkrg([DB11:DJ51], [BO144:BW184])
ElseIf [BZ187] = "Ok" Then
Call linkrg([DB11:DJ51], [BO187:BW227])
ElseIf [BZ230] = "Ok" Then
Call linkrg([DB11:DJ51], [BO230:BW270])
ElseIf [BZ273] = "Ok" Then
Call linkrg([DB11:DJ51], [BO273:BW313])
End If
If [AX316] = "Ok" Then
Call linkrg([CK57:CS97], [BA316:BI356])
ElseIf [AX359] = "Ok" Then
Call linkrg([CK57:CS97], [BA359:BI399])
ElseIf [AX402] = "Ok" Then
Call linkrg([CK57:CS97], [BA402:BI442])
ElseIf [AX445] = "Ok" Then
Call linkrg([CK57:CS97], [BA445:BI485])
ElseIf [AX488] = "Ok" Then
Call linkrg([CK57:CS97], [BA488:BI528])
End If
If [BZ316] = "Ok" Then
Call linkrg([DB57:DJ97], [BO316:BW356])
ElseIf [BZ359] = "Ok" Then
Call linkrg([DB57:DJ97], [BO359:BW399])
ElseIf [BZ402] = "Ok" Then
Call linkrg([DB57:DJ97], [BO402:BW442])
ElseIf [BZ445] = "Ok" Then
Call linkrg([DB57:DJ97], [BO445:BW485])
ElseIf [BZ488] = "Ok" Then
Call linkrg([DB57:DJ97], [BO488:BW528])
End If
Cells(12, 1).Activate
ActiveWindow.ScrollRow = ActiveCell.Row
End Sub

Reply
réponses:
  • gbinforme

    Mais non tu laisses ta procédure "RecopiePlage" telle qu'elle est probablement dans un module et tu mets seulement celle que j'ai mis dans ta feuille.

  • auteur

    ta solution ne va pas parceque ca copie en boucle
    sans arret et ca perturbe le graphe ce que je veux c'est que la copie se fasse seulement quand une des cellules contenant les ok change soinon c'est injouable

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

autrement dit il faut que la copie se fasse une seule fois par cellule qui contiennent les OK
il ya 20 cellules qui peuvent recevoir les OK mais seulement 4 qui les affichent donc si un seul des ok change de destination de cellule il faut que instantanément la copie de la plage se fasse mais une seule fois ( jusqu a ce que a nouveau une autre destination est detectée
je ne sais pas si tu vas comprendre le but de ce code

Reply
réponses:

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

Bonjour

je suis revenue a mon code de départ qui fonctionne très bien avec un bouton je ne suis pas un programmeur je le répète,mais il me semble que si un premier code permet d'afficher en mode valeur les 4 OK vers des cellules a cote ;il peut y avoir a lors un autre code qui va actionner la macro recopieplage
un premier code qui dirait grosso modo si les cellules abcd etc sont égale à "OK"; copier les en mode valeur vers les cellules .......
un deuxieme qui dit des qu 'une des 4 cellules contenant OK passe à ("") executer la macro recopieplage





Option Compare Text
Private Sub linkrg(target As Range, source As Range)
source.Copy
target.Parent.Activate
target.Select
target.Parent.Paste link:=True
Application.CutCopyMode = False
End Sub
Sub RecopiePlage()

Application.ScreenUpdating = True


If [AX101] = "Ok" Then
Call linkrg([CK11:CS51], [BA101:BI141])
ElseIf [AX144] = "Ok" Then
Call linkrg([CK11:CS51], [BA144:BI184])
ElseIf [AX187] = "Ok" Then
Call linkrg([CK11:CS51], [BA187:BI227])
ElseIf [AX230] = "Ok" Then
Call linkrg([CK11:CS51], [BA230:BI270])
ElseIf [AX273] = "Ok" Then
Call linkrg([CK11:CS51], [BA273:BI313])
End If
If [BZ101] = "Ok" Then
Call linkrg([DB11:DJ51], [BO101:BW141])
ElseIf [BZ144] = "Ok" Then
Call linkrg([DB11:DJ51], [BO144:BW184])
ElseIf [BZ187] = "Ok" Then
Call linkrg([DB11:DJ51], [BO187:BW227])
ElseIf [BZ230] = "Ok" Then
Call linkrg([DB11:DJ51], [BO230:BW270])
ElseIf [BZ273] = "Ok" Then
Call linkrg([DB11:DJ51], [BO273:BW313])
End If
If [AX316] = "Ok" Then
Call linkrg([CK57:CS97], [BA316:BI356])
ElseIf [AX359] = "Ok" Then
Call linkrg([CK57:CS97], [BA359:BI399])
ElseIf [AX402] = "Ok" Then
Call linkrg([CK57:CS97], [BA402:BI442])
ElseIf [AX445] = "Ok" Then
Call linkrg([CK57:CS97], [BA445:BI485])
ElseIf [AX488] = "Ok" Then
Call linkrg([CK57:CS97], [BA488:BI528])
End If
If [BZ316] = "Ok" Then
Call linkrg([DB57:DJ97], [BO316:BW356])
ElseIf [BZ359] = "Ok" Then
Call linkrg([DB57:DJ97], [BO359:BW399])
ElseIf [BZ402] = "Ok" Then
Call linkrg([DB57:DJ97], [BO402:BW442])
ElseIf [BZ445] = "Ok" Then
Call linkrg([DB57:DJ97], [BO445:BW485])
ElseIf [BZ488] = "Ok" Then
Call linkrg([DB57:DJ97], [BO488:BW528])
End If
Cells(12, 1).Activate
ActiveWindow.ScrollRow = ActiveCell.Row
End Sub

Reply
réponses:

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

ya un truc que je pige pas explique moi pourquoi on peut pas faire un code qui dit si la cellule un tel est compris entre un chiffre et ce chiffre actionner moi la macrocopie plage une seule fois;si la cellule un tel est comprise entre un chiffre et ce chiffre actionner moi la macro recopieplage une seule fois ......etc
ca dépasse tout entendement on complique les choses la ou elles sont simples y a des choses bien plus compliquées que celle la qui ont été faite sans se prendre le teston

Reply
réponses:
  • gbinforme

    ya un truc que je pige pas
    Peut-être postuler chez Microsoft pour faire qu'excel fonctionne selon tes désirs ;-)

  • yg_be

    c'est simple à comprendre (et je t'ai dèjà expliqué ici).
    il ne suffit pas d'écrire du code, il faut qu'Excel le démarre.
    il y a plusieurs façons de faire démarrer un code:
    - par timer
    - par un bouton ou une combinaison de touches
    - quand le contenu d'une cellule change (les changements de résultats des formules ne comptent pas)
    - quand une feuille est recalculée, ce qui inclut les changements de résultat d'une formule
    .

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

ça c'est la réponse de quelqu'un qui ne connait pas la solution et qui ne la trouvera jamais
je ne suis pas inquiet je suis persuade que c'est faisable ,c'est une macro sous condition
petit a petit je vais apprendre rien n'est impossible

Reply
réponses:
  • gbinforme

    Bonsoir,

    ça c'est la réponse de quelqu'un qui ne connait pas la solution et qui ne la trouvera jamais

    Je te remercie de ton analyse et je vais essayer de la déjouer. Copie cette procédure très simplifiée par rapport à ton code initial dans ta feuille concernée et tu nous fait une nouvelle analyse. ;-)

    Option Explicit Private Sub worksheet_Calculate() Const cok = "AX101,AX144,AX187,AX230,AX273,BZ101,BZ144,BZ187,BZ230,BZ273,AX316,AX359,AX402,AX445,AX488,BZ316,BZ359,BZ402,BZ445,BZ488" Const cpo = "CK11:CS51,CK11:CS51,CK11:CS51,CK11:CS51,CK11:CS51,DB11:DJ51,DB11:DJ51,DB11:DJ51,DB11:DJ51,DB11:DJ51,CK57:CS97,CK57:CS97,CK57:CS97,CK57:CS97,CK57:CS97,DB57:DJ97,DB57:DJ97,DB57:DJ97,DB57:DJ97,DB57:DJ97" Const cpd = "BA101:BI141,BA144:BI184,BA187:BI227,BA230:BI270,BA273:BI313,BO101:BW141,BO144:BW184,BO187:BW227,BO230:BW270,BO273:BW313,BA316:BI356,BA359:BI399,BA402:BI442,BA445:BI485,BA488:BI528,BO316:BW356,BO359:BW399,BO402:BW442,BO445:BW485,BO488:BW528" Dim elk, elo, eld, idc As Integer Static avd(20)     elk = Split(cok, ","): elo = Split(cpo, ","): eld = Split(cpd, ",")     For idc = 0 To UBound(elk)         If LCase(avd(idc)) <> "ok" And LCase(Range(elk(idc)).Value) = "ok" Then                Range(elo(idc)).Copy Destination:=Range(eld(idc))         End If         avd(idc) = Range(elk(idc)).Value     Next idc End Sub 

  • yg_be

    bonjour, je suggère de remplacer

    Range(elo(idc)).Copy Destination:=Range(eld(idc))

    par
    Call linkrg ( Range(eld(idc)) , Range(elo(idc)) )

  • gbinforme

    Bonjour yg_be,
    Je connais bien ta suggestion "implicite" sauf qu'elle ne fonctionne pas dans certaines configurations par défaut d'excel et donc lorsque l'on ne sait pas celle concernée, je m'abstiens du code par défaut.
    Tu peux d'ailleurs vérifier l'exemple de l'aide Microsoft qui utilise ma syntaxe :
    https://msdn.microsoft.com/fr-fr/VBA/excel-vba/articles/range-copy-method-excel?f1url=https%3A%2F%2Fmsdn.microsoft.com%2Fquery%2Fdev11.query%3FappId%3DDev11IDEF1%26l%3Dfr-FR%26k%3Dk%28vbaxl10.chm144104%29%3Bk%28TargetFrameworkMoniker-Office.Version%3Dv15%29%26rd%3Dtrue

  • yg_be

    je pense que, contrairement à ce qu'il écrit, chrisnapoli souhaite créer des liens, pas copier. d'où ma suggestion.

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

Bonsoir
je viens de voir ton code je ne peux que l 'essayer
je n ai pas assez de connaissance dans le domaine pour le commenter
demain après midi je serais fixé
le matin je vais avoir certaines occupations qui m empêcheront de me servir du temps réel
je suppose que si tu m 'as répondu ainsi c'est que tu es sur de ton coup
si ca marche j espère que tu me donneras la logique de tous ces signes..... qui ne sont pour moi aujourd’hui que du chinois mais le chinois comme toutes langue cela s'apprend avec beaucoup de temps et de volonté

Reply

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

bonjour
jre viens juste de renter j ai essaye le code ca ne fonctionne pas du tout alors je vais essayer de remplacer en partie par la propostionde Ygbe
on verra

Reply

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

re je viens d'essayer a nouveau mais malgre ce nouveau code il n y rien qui fonctionne

Reply
réponses:
  • auteur

  • yg_be

    "rien qui fonctionne", c'est un peu opaque.
    retourne dans la situation que tu avais le 13 juin 2018 à 17:19.
    ca marchait mais le problème est que ca tournait en boucle: cela devrait aller mieux avec le nouveau code.

  • auteur

    je viens de remettre le code comme tu me l avais fai t et ca marche parfaitement avec le bouton mais si j ajoute dans la feuille
    Private Sub Worksheet_Calculate() ca se met à tourner en boucle
    Call RecopiePlage

    quand au code que m a écrit gbinforme je suis désole mais il n y a rien qui fonctionne même en le modifiant avec la ligne que tu m 'as propose ce code est dans un module

  • yg_be

    le code proposé par gbinforme doit être dans une feuille.

  • auteur

    si je le mets dans la feuille alors au lieu de m afficcher les cotations en % cela m 'affiche 0.000% sur toute la feuille

  • yg_be

    as-tu utilisé linkrg?

  • gbinforme

    Bonsoir,

    cela m 'affiche 0.000% sur toute la feuille
    Le code ne fait que de la copie de plage mais en mettant du code n'importe où, l'on ne peux pas savoir ce que tu nous as fait ?
    Le code fonctionne et ne fait que la copie des plages afférentes à la cellule qui passe à "Ok" mais comme il faut deviner la structure de ta feuille qui a sans doute en plus d'autres procédures que je ne connais pas, tu as sans doute créé avec des procédures événementielles ou autres, des cas particuliers en changeant les plages concernées par exemple.

  • auteur

    je n ai fait que faire ce que tu m 'as dit j ai mis le code dans la feuille et dans la feuille il y a déjà cette procédure
    Option Explicit
    Sub Worksheet_SelectionChange(ByVal target As Range)
    Dim Lig As Byte, Col As Byte
    If Not Application.Intersect(target, Range("CV12:CV51,CX12:CX51,CV58:CV97,CX58:CX97")) Is Nothing Then
    Range("DP2") = target
    End If
    End Sub

    c'est sans doute pour cette raison que ton collègue ma dit de mettre ma macro dans un module a part
    pour ton code jai essaye dans ma feuille comme tu m as dits mais également dans le module si la procédure qui est déjà dans la feuille gène ton code il suffit de me dire ou je peux le déplacer
    je ne peux pas deviner je t'ai deja dit que je n avais pas la compétence ,je suis oblige de m 'en tenir a ce que vous me dites
    j ai egalement essayer de changer la ligne comme me l a demande YGB mais sans résultat je vais supprimer la procedure de la feuille remettre ton code et dits moi ou je peux mettre cette procedure dont j ai besoinegalement
    Option Explicit
    Sub Worksheet_SelectionChange(ByVal target As Range)
    Dim Lig As Byte, Col As Byte
    If Not Application.Intersect(target, Range("CV12:CV51,CX12:CX51,CV58:CV97,CX58:CX97")) Is Nothing Then
    Range("DP2") = target
    End If
    End Sub

  • yg_be

    la prochaine fois que tu montres du code, peux-tu utiliser la coloration syntaxique?

  • auteur

    ok
    alors dits moi si j'enleve ce code de ma feuille puisque semble til cela gene son code ou dois je le mettre alors ????
    Option Explicit
    Sub Worksheet_SelectionChange(ByVal target As Range)
    Dim Lig As Byte, Col As Byte
    If Not Application.Intersect(target, Range("CV12:CV51,CX12:CX51,CV58:CV97,CX58:CX97")) Is Nothing Then
    Range("DP2") = target
    End If
    End Sub

  • yg_be

    merci d'utiliser la coloration syntaxique quand tu montres du code. c'est gentil d'écrire "ok", ce serait mieux de le faire. maintenant.

  • auteur

    mais comment faits tu ??

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

oui j ailu mais c'est pas du tout clair
Un simple clic sur l'icone insère les balises "génériques", sans indication de langage, et donc sans coloration associée. Selon le langage et la capacité du site à le reconnaitre le rendu peut être loin de celui espéré.

Reply
réponses:
  • yg_be

    merci de passer le temps nécessaire pour maîtriser cela et mieux communiquer.

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

le probleme il est pas dans la couleur du code

Reply

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

mais comment veux tu maîtriser tellement que c'est mal explique il n y a a aucun endroit marqué comment tu dois faire pour colorier le code je le vois nulle part
moi je crois que le plus important c'est de savoir ou je mets le code qui gêne le sien dans la feuille sinon on va jamais y arriver

Reply
réponses:
  • yg_be

    avec un peu de temps et de volonté, tu vas y arriver. merci de persévérer.

  • gbinforme

    Bonsoir,

    Si tu n'as que les 6 lignes de codes listées cela ne peut en aucune manière influer sur le code des copies qui ne fait pas de sélection. Par contre je ne sais pas (et je n'ai pas à le savoir) ce que fait ton classeur mais il y a bien une action qui vient modifier les "ok" et cette action si elle résulte d'une procédure peut éventuellement avoir une influence.

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

je t'explique on va prendre par exemple quelques cellules qui contiennent ou pas le Ok (cellule BZ101)
la formule est la suivante=SI(BY101>0,0175;"OK";"")
dans BY101 tu as =MAX(BO102:BW141)

Dans BZ 144 la formule est la suivante =SI(ET(BY144>0,014;BY144<=0,0175);"OK";"")
BY144 tu as =MAX(BO145:BW184)

Dans BZ 187la formule est la suivante
=SI(ET(BY187>0,009;BY187<=0,014);"OK";"")
BY187 tu as =MAX(BO188:BW227)

Dans BZ 230la formule est la suivante
=SI(ET(BY230>0,005;BY230<=0,009);"OK";"")
BY230 tu as =MAX(BO231:BW270)

Dans BZ 273la formule est la suivante
=SI(ET(BY273>=0;BY273<=0,005);"OK";"")
BY273 tu as =MAX(BO274:BW313)

etc... le OK est donne par rapport au Max des plages contenue dans ces cellules bypour celles la et de l autre cote c'est AY et les OK sont en AX
selon que le Max correspond aux criteres exiges en BZ les ok sinscrivent a leur places il ya 2 ok de chaque cote par graphe

Reply
réponses:
  • gbinforme

    Dans BZ 144 la formule est la suivante =SI(ET(BY144>0,014;BY144<=0,0175);"OK";"")
    Par exemple, dans ce cas, comment est modifié BY144 ?

    J'ai modifié le code pour éviter toutes les actions autres pendant son déroulement, essaies cette version :

    Private Sub worksheet_Calculate() Const cok = "AX101,AX144,AX187,AX230,AX273,BZ101,BZ144,BZ187,BZ230,BZ273,AX316,AX359,AX402,AX445,AX488,BZ316,BZ359,BZ402,BZ445,BZ488" Const cpo = "CK11:CS51,CK11:CS51,CK11:CS51,CK11:CS51,CK11:CS51,DB11:DJ51,DB11:DJ51,DB11:DJ51,DB11:DJ51,DB11:DJ51,CK57:CS97,CK57:CS97,CK57:CS97,CK57:CS97,CK57:CS97,DB57:DJ97,DB57:DJ97,DB57:DJ97,DB57:DJ97,DB57:DJ97" Const cpd = "BA101:BI141,BA144:BI184,BA187:BI227,BA230:BI270,BA273:BI313,BO101:BW141,BO144:BW184,BO187:BW227,BO230:BW270,BO273:BW313,BA316:BI356,BA359:BI399,BA402:BI442,BA445:BI485,BA488:BI528,BO316:BW356,BO359:BW399,BO402:BW442,BO445:BW485,BO488:BW528" Dim elk, elo, eld, idc As Integer Static avd(20)     Application.EnableEvents = False     Application.Calculation = xlCalculationManual     elk = Split(cok, ","): elo = Split(cpo, ","): eld = Split(cpd, ",")     For idc = 0 To UBound(elk)         If LCase(avd(idc)) <> "ok" And LCase(Range(elk(idc)).Value) = "ok" Then             Range(eld(idc)).Copy             Range(elo(idc)).Select             Range(elo(idc)).Parent.Paste link:=True         End If         avd(idc) = Range(elk(idc)).Value     Next idc     Application.Calculation = xlCalculationSemiautomatic     Application.EnableEvents = True End Sub 

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

Bonjour
tout simplement je sélectionne la plage et je rentre le MAX de la plage donc le changement se fait automatiquement par la fonction MAX en temps réel pour ton information ,j étais arrivé à solutionner le problème seulement avec des formules mais j avais un soucis parce que lorsque tu incrémentes trop de formules par cellule excel te renvoie la valeur en nombre entier à plusieurs décimales et il est impôssible de ramener le format en pourcentage j étais oblige de faire 20 plages supplémentaires pour multiplier toutes les cellules par1 afin d avoir le bon format en % mais la aussi ce n était pas une bonne solution parce que lorsque j'ouvrais mon fichier cela mettait un temps infini a s'ouvrir(je ne sais pas pourquoi??sinon le graphe marchait la procédure des OK étaient respecte automatiquement

au départ le graphe fonctionnait parfaitement bien mais sur une seule échelle
0,25% 0,50% 0,75% 1,00% 1,25% 1,50% 1,75% 2,00% >2,00%



j ai fait ceci pour rendre les graphes plus
dynamiques il y a 20 plages 10 plages par graphes 5 de positives a droite (vert)pour les barres de droite et 5 de négatives pour les barres de gauche(rouges) la première échelle(la plus petite) est de

0,05% 0,10% 0,15% 0,20% 0,25% 0,30% 0,35% 0,40% >0,40%
puis
0,10% 0,20% 0,30% 0,40% 0,50% 0,60% 0,70% 0,80% >0,80%
puis
0,15% 0,30% 0,45% 0,60% 0,75% 0,90% 1,05% 1,20% >1,20%
puis
0,20% 0,40% 0,60% -0,80% 1,00% 1,20% 1,40% 1,60% >1,60%
puis
0,25% 0,50% 0,75% 1,00% 1,25% 1,50% 1,75% 2,00% >2,00%
pareil mais inverse pour le cote negatif
-0,40% -0,35% -0,30% -0,25% -0,20% -0,15% -0,10% -0,05%
etc........
chaque fois que un max de la plage dépasse le critère annoncé dans la cellule ou se trouve le ok on saute de un pas ou on recule de un pas, c'est suivant(ne s’affiche sur le graphe que les plages qui contiennent les ok donc 4 plages maxi
2 pour chaque graphe une pour le positif l autre pour le négatif
ce sont tout simplement des barres de progression Horizontales et au milieu une colonne avec les noms des 40 valeurs du Cac 40

Reply

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

re
j ai oublie de te dire au final c'est laf onction Max qui donne le chiffre contenue dans BY et ce chiffre varie parce que le temps réel arrive sur le fichier par une API qui donne instantanément le cours de l action automatiquement

Reply

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

L obstination et la bonne volonté finissent toujours par payer
je viens d'essayer
première des choses, hier j avais remis mon ancien code qui marchait avec le bouton
en fin de journée jai fait quelques manip du bouton puis j ai ferme mon fichier une heure avant la fin de séance
a ce moment la ,toutes les plages étaient au max(la dernière barre), sauf une qui était sur un pas différent (en dessous)
donc quand j ai ouvert le fichier aujourd’hui j'ai pris bien soin de regarder je n ai pas activé le logiciel qui me fournit le temps réel(car il aurait mis les cotations a jour)
j ai rentre ton nouveau code puis j'ai fermé le fichier puis réouvert avec le logiciel et la mise à jour des cotations de fin de journée
et la, miracle la barre qui était à l' Echelle en dessous s'est mis a la bonne échelle'( puisque le cours de séance en fin de journée et toutes les plages étaient hier soir sur échelle Maximum
donc apparemment ton nouveau code marche a vérifier lundi avec le temps réel en action mais je pense que cela va marcher(aujourd’hui les bourses ne marchent pas)

le seul problème ,c'est que en fin de procédure la plage du 2eme graphe était grise par sélection et les graphes n étaient pas revenue a la ligne 12 de départ ils avaient bougé un peu vers le bas j ai rajoute ce bout de code et apparemment cela marche tout revient a la position de départ

Cells(12, 1).Activate
ActiveWindow.ScrollRow = ActiveCell.Row

""Félicitation"" je pense que tu as trouvé la bonne solution (nous verrons Lundi)
Peux tu me dire si je peux te consulter à nouveau pour mes 3 derniers problème( si tu as le temps) un est lie directement avec ce que tu viens de trouver(mais je ne sais pas si il sera possible de solutionner mon désir (parce que apparemment c'est extrêmement complexe)
les 2 autres sont lie a un timer que m a fait YGB avec succès et que je veux rendre plus performant
après c'est termine j aurais ouvert mon site web et vous serez les premiers a le consulter

Reply
réponses:
  • gbinforme

    apparemment c'est extrêmement complexe
    Dis toujours je ne sais pas si l'on peux te donner 3 solutions mais impossible n'est pas français depuis plus de 2 siècles, alors... ;-)

Marsh

NOVEMBER 9, 2013 AT 9:15 PM

Bonjour
voila mon second soucis
j ai un timer qui me relève les cotations toute les minutes de la journee j ai un timer qui marche très bien sur un seul marché
donc j ai essaye de le dupliquer sur 4 marchés sur le même fichier sur 4 feuilles différentes les marches démarrant et se terminant a la même heure seules la nature des cotations est differente je ne sais pas pourquoi le deuxieme fichier ne fonctionne pas, je ne sais pas d'ou vient l 'erreur dans le code??
je mets les 2 codes en dessous le premier marche
dans woorkbooksheet j ai

Option Explicit

Private Sub Workbook_Open()
Sheets("statist").Select
c = 383
Application.OnTime TimeValue("09:01:00"), Procedure:="RecupCotation" '"09:01:00"
'Range("NR12:AHW131").ClearContents
End Sub



Private Sub Workbook_BeforeClose(Cancel As Boolean)
copy_dh
End Sub
Private Sub copy_dh()
Dim sh As Worksheet
Set sh = Sheets("statist")
sh.Range("D12:H51").Value = sh.Range("AS12:AW51").Value
sh.Range("C12:C51").ClearContents
sh.Range("C11") = Now
End Sub
dans module1 j ai
Public Durée As Date
Public c

Sub RecupCotation()
Durée = Now + TimeValue("00:01:00") ' A remplacer par "00:01:00"
Application.OnTime Durée, "RecupCotation"
Range(Cells(12, c), Cells(131, c)) = Range("A12:A131").Value
c = c + 1
If c >= 908 Then ArretCotation 'N° de la dernière colonne
End Sub


Sub ArretCotation()
On Error Resume Next
Application.OnTime Durée, "RecupCotation", , False
End Sub

Public Durée1 As Date
Public c As Long
Public TempsInitial1 As Date
Public TempsInitial1Num As Double
Public T1
Public Tempo1

Sub RecupCotation1()
If T1 >= 60 Then T1 = 0 '60
Durée1 = Format(TempsInitial1Num + (T1 * Tempo1), "hh:mm:ss")
Application.OnTime Durée1, "RecupCotation1"
Range(Cells(12, c), Cells(131, c)) = Range("A12:A131").Value
Dim l As Long
For l = 12 To 51
If Cells(l, "C").Value <> "ok" Then
If Cells(l, "D").Value <> Cells(l, "AS").Value _
Or Cells(l, "E").Value <> Cells(l, "AT").Value _
Or Cells(l, "F").Value <> Cells(l, "AU").Value _
Or Cells(l, "G").Value <> Cells(l, "AV").Value _
Or Cells(l, "H").Value <> Cells(l, "AW").Value Then
Cells(l, "C").Value = "ok"
Else
Cells(l, c).ClearContents
Cells(l + 40, c).ClearContents
Cells(l + 80, c).ClearContents
End If
End If
Next l
Application.Wait Now + TimeValue("00:00:01")
TempsInitial1Num = TempsInitial1Num + Tempo1
If c >= 908 Then ArretCotation1 'N° de la dernière colonne des cotations à la minute
c = c + 1
End Sub
Sub ArretCotation1()
On Error Resume Next
Application.OnTime Durée1, "RecupCotation1", , False
End Sub
dans module6 j ai
Private Sub Workbook_BeforeClose(Cancel As Boolean)
copy_dh
End Sub
Private Sub copy_dh()
Dim sh As Worksheet
Set sh = Sheets(feuille)
sh.Range("D12:H51").Value = sh.Range("AS12:AW51").Value
sh.Range("C12:C51").ClearContents
sh.Range("C11") = Now
End Sub

Pour le deuxième fichier avec les 4 feuilles j ai dans this workbook

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
copy_dh
End Sub

Private Sub Workbook_Open()
init_marches
End Sub

puis dans module 1 j' ai

Option Explicit
Public Durée As Date
Public c

Sub RecupCotation()
Durée = Now + TimeValue("00:01:00") ' A remplacer par "00:01:00"
Application.OnTime Durée, "RecupCotation"
Range(Cells(12, c), Cells(131, c)) = Range("A12:A131").Value
c = c + 1
If c >= 908 Then ArretCotation 'N° de la dernière colonne
End Sub


Sub ArretCotation()
On Error Resume Next
Application.OnTime Durée, "RecupCotation", , False
End Sub

Public Durée1 As Date
Public c As Long
Public TempsInitial1 As Date
Public TempsInitial1Num As Double
Public T1
Public Tempo1

Sub RecupCotation1()
If T1 >= 60 Then T1 = 0 '60
Durée1 = Format(TempsInitial1Num + (T1 * Tempo1), "hh:mm:ss")
Application.OnTime Durée1, "RecupCotation1"
Range(Cells(12, c), Cells(131, c)) = Range("A12:A131").Value
Dim l As Long
For l = 12 To 51
If Cells(l, "C").Value <> "ok" Then
If Cells(l, "D").Value <> Cells(l, "AS").Value _
Or Cells(l, "E").Value <> Cells(l, "AT").Value _
Or Cells(l, "F").Value <> Cells(l, "AU").Value _
Or Cells(l, "G").Value <> Cells(l, "AV").Value _
Or Cells(l, "H").Value <> Cells(l, "AW").Value Then
Cells(l, "C").Value = "ok"
Else
Cells(l, c).ClearContents
Cells(l + 40, c).ClearContents
Cells(l + 80, c).ClearContents
End If
End If
Next l
Application.Wait Now + TimeValue("00:00:01")
TempsInitial1Num = TempsInitial1Num + Tempo1
If c >= 908 Then ArretCotation1 'N° de la dernière colonne des cotations à la minute
c = c + 1
End Sub
Sub ArretCotation1()
On Error Resume Next
Application.OnTime Durée1, "RecupCotation1", , False
End Sub

puis dans module 6 j'ai
Private Sub Workbook_BeforeClose(Cancel As Boolean)
copy_dh
End Sub
Private Sub copy_dh()
Dim sh As Worksheet
Set sh = Sheets(feuille)
sh.Range("D12:H51").Value = sh.Range("AS12:AW51").Value
sh.Range("C12:C51").ClearContents
sh.Range("C11") = Now
End Sub

Puis dans module 8 j ai

Option Explicit

Dim marches() As Worksheet

Sub copy_dh()
Dim marche As Variant
Dim fl As Worksheet
For Each marche In marches
Set fl = marche
Call copy_dhfl(fl)
Next marche
End Sub
Private Sub copy_dhfl(sh As Worksheet)
sh.Range("D12:H51").Value = sh.Range("AS12:AW51").Value
sh.Range("C12:C51").ClearContents
sh.Range("C11") = Now
End Sub
Sub init_marches()
ReDim marches(3)
Set marches(0) = Sheets("CAC40")
Set marches(1) = Sheets("AEX")
Set marches(2) = Sheets("BEL20")
Set marches(3) = Sheets("PSI20")
End Sub

Reply

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed