faire remonter les lignes en programmant Fermé

Question

Bonjour, Bonjour 
Je voudrais solutionner ce problème avec Visual Basic
J ai un tableau Excel 2016 avec deux plages CV12:CV51 puis Cx12 :CX51
Lorsque j utilise mon tableau Excel, j’ai en permanence une barre de fractionnement en horizontal qui englobe la 11 -ème ligne
En vertical j ai une autre barre de fractionnement qui englobe la colonne CZ( quand on part de la gauche du tableau vers la droite

 je voudrais lorsque je  double clique dans la plage de gauche CV12 :CV51 je voudrais que mes lignes remontent dans cet ordre

Si je double clique par exemple sur CV12 je voudrais passer en dessous de ma barre de fractionnement de le la ligne 12 à la ligne 227
Si je double clique par exemple sur CV13 je voudrais passer en dessous de ma barre de fractionnement de le la ligne 12 à la ligne 313
Si je double clique par exemple sur CV14 je voudrais passer en dessous de ma barre de fractionnement de le la ligne 12 à la ligne 399
Si je double clique par exemple sur CV15 je voudrais passer en dessous de ma barre de fractionnement de le la ligne 12 à la ligne 485
Etc jusqu’à CV51

je voudrais lorsque je  double clique dans la plage de Droite CX12 :CX51 je voudrais que mes lignes remontent dans cet ordre

Si je double clique par exemple sur CX12 je voudrais passer en dessous de ma barre de fractionnement de le la ligne 12 à la ligne 270
Si je double clique par exemple sur CX13 je voudrais passer en dessous de ma barre de fractionnement de le la ligne 12 à la ligne 356
Si je double clique par exemple sur CX14 je voudrais passer en dessous de ma barre de fractionnement de le la ligne 12 à la ligne 442
Si je double clique par exemple sur CX15 je voudrais passer en dessous de ma barre de fractionnement de le la ligne 12 à la ligne 528
Etc jusqu’à CX51

Il me faut également une macro qui me donne la possibilité de n’ importe quelle emplacement  ou je serais , de pouvoir revenir d’un clic à la position initiale de départ c’est-à-dire la ligne 12 en dessous de ma barre de fractionnement
 je mettrai ce Bouton en  cellule DI10j au dessus de ma barre de fractionnement (se situant en ligne11, comprise)
Merci de me dire si c’est réalisable et si cette macro ne va pas venir en contradiction avec une autre macro simple clic que je b viens d’intégrer a ma feuille  ,décrite si dessous(attention je ne suis pas programmeur ,je bricole Merci de vos solutions

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")) Is Nothing Then 
Range("DP2") = Target 
Lig = Target.Row 
Col = Target.Column 
If Col = 100 Then 
Range("CW52") = Cells(Lig, "DX") 
Else 
Range("CW52") = Cells(Lig, "DW") 
End If 
End If 
End Sub




Configuration: Windows / Chrome 64.0.3282.186

michel_m · Answer

Bonjour,

Qu'appelles tu "barre de fractionnement" ? 

pour le risque de collision entre tes 2 événement, cette maquette te montre qu'il n'y a pas collision
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)If Target.Address = "$A$2" Then: MsgBox "double"End SubPrivate Sub Worksheet_SelectionChange(ByVal Target As Range)If Target.Address = "$A$2" Then: MsgBox "simple"End Sub

michel_m · Answer

Salut

Comme d'hab, je fais une proc bidon pour étudier le principe demandé

ici,   on cache de la ligne 12 à la ligne 50 (227 ) avec un pas de 5 (86) suivant la ligne sélectionnée ( 20 pour l'étude); Si je mets 21 par ex on agrandira les lignes Masquées de 5 soit ligne 12 à 55 masquées ( il y a peut-^tre un moins 1 qui traine à étudier!)

Sub cacher()Dim Lignes As String, Deb As Byte, Fin As IntegerDeb = 20Fin = 50 + 5 * (Deb - 20)Lignes = 12 & ":" & FinRows(Lignes).Hidden = TrueEnd Sub

 j'insiste: ce n'est que le principe pour cacher des lignes suivant la valeur d'une cellule. l'étape suivante est d'utiliser les proc événementielles: peut-^tre peux tu le faire

michel_m · Answer

Tu dis...
https://mon-partage.fr/f/6Fn34v7H/

michel_m · Answer

Merci d'utiliser "répondre" plutôt que  "commenter"

chrisnapoli · Answer

salut michel 
j ai un petit soucis  j ai fait comme je t ai dit une copie de ma feuille ou je n ai garde que le strict nécessaire donc ça marche maintenant rapidement ,sauf que sur les dernières valeurs ca ne fonctionne pas 
j ai regarde ton programme et tu as arrete a 3500 donc j ai remis le chiffre de 3624 correspondant a celui qui doit s 'afficher si je clique sur CX51 et ca ne me remonte pas  a la ligne 12 et lorsque j appuie sur la CV51 c'est celle de la CX51 qui s affiche  j ai vu que d a partir de la ligne 35000 les lignes étaient masquées donc je les ai démasqué mais j ai toujours un problème
 je cherche d ou vient ce schmilblic

chrisnapoli · Answer

ca y est Michel tout marche impeccable  j ai réparé ,merci demain je te parlerais d une chose bien plus compliquée merci et bonne soirée

michel_m · Answer

Bonjour,
1/
JE T'AI DEMANDE  D'UTILISER "REPONDRE AU SUJET" ET NON "COMMENTER LA REPONSE"
 
et tu t'en fous complétement

2/ tu fais des demandes incomplètes  et il faudrait que je repasse du temps pour réparer ton inconséquence ?
LA REPONSE EST  NON

chrisnapoli · Answer

Salut Michel 
C'est bon pas la peine de se fâcher pour rien j'ai pas l habitude de ce forum ;excuse moi,  tu as fait du bon travail  j ai réparé c était pas le bout du monde désolé j ai plus de 60 balais et j ai pas la verve d'un tout jeune,il faut m'excuser
Pour le reste c'est dommage parce que c'est quelque chose qui te permettrait de te dépasser ,je pense que vous aimez vous les programmeurs ,la difficulté ; mais bon tu es libre de tes décisions 
merci d 'avoir solutionner mon premier problème aussi rapidement le résultat est très positif

Bonne journée,encore une fois je te remercie

chrisnapoli · Answer

salut Michel 
 c'est bien tu es dans de meilleures dispositions 
rien ne sert de  s'embrouiller pour des futilités ,si ce n 'est pas compliqué pour toi ça l 'est pour moi ,je suis sculpteur de métier
je te propose  de jeter un œil pour un soucis complètement insurmontable pour moi si ça te dit sinon ce n 'est pas grave .
j ai un classeur que l on nommera A, ce classeur, dès son ouverture appelle 2 autres classeurs B et C, dans lesquels sont enregistres des programmes différents ,qui s appliquent au classeur A
Ce sont deux timers qui me collent des cotations a intervalles réguliers
pour un il colle toutes les minutes  a partir de 09:00:01 et jusqu a 09:30:00
pour l autre toutes les 15 mn a partir de 09:30 jusqu a 17:45:00 ces cotations sont inscrites dans le Classeur A en colonne A de A12 :A131
les cotations dans cette plage sont tires directement des plages AU12:AU51 (qui sont le dernier cours enregistré)
puis de AV12:AV51 (qui sont les plus Haut de séance)
puis de AW12:AW51( qui sont les plus Bas de séance) les cotations dans ces 3 plages sont inscrites en temps réel par un logiciel d'importation de liens DDE(Data Dynamic Exchange) , ces cotations boursieres s'inscrivent dans Excel en Streaming en vrai temps réel
 mon problème est le suivant , lorsque le marche financier ouvre a 09:00:00 les cotations s'inscrivent dans mon classeur A dans un emplacement bien défini de telle façon que je puisse analyser a quelle heure sont les PH et PB de séance,mon soucis est que certains jours il y a des mouvements de panique a l ouverture et de nombreux traders vendent en même temps  empêchant le cours d'ouverture d’être fixé certains jours il arrive que sur des valeurs le cours d'ouverture ne soit fixé que 2 a 4 voir 5 mn après 09:00:00 entraînant ainsi une erreur sur mon classeur A ,puisque ces cotations avant fixation du prix d'ouverture s'inscrivent tout de même et faussent ainsi les résultats Pour bien aller il faudrait que le Timer commence a coller chaque valeur séparément, seulement lorsque le prix d'ouverture est fixée le seul moyen pour cela est que il prenne en compte le fait que des que les PB et PH changent dans les plages AV12:AV51 et AW12:AW51 c'est a dire à partir de 09:00:00, a ce moment la et seulement a ce moment la les cotations pourront s'inscrire 
le soucis est que si on fait un programme qui n enclenche pas le collage des  cotations tant que les PB et PH n' aient pas changé , comment faire pour que les cotations s'inscrivent en face des heures sur mon classeur Pour comprendre il faut savoir que les cotations de la colonne A se collent ainsi dans la feuille
en colonne NR12:NR131 pour celles de 09:00:00 en NS12:NS131 pour celles 09:01:00;en NT12:NT131 pour 09:02:00 :etc jusque a la colonne QF12:QF131 pour les cotations de 17:45:00
Je vous précise que sur la ligne 11 et a partir de NR11 sont inscrits les repaires des heures
Cellule NR11 (09:00:00) Cellule NS11(09:01:00) cellule NT11(09:02:00) jusqua QF11(17:45:00) 

je vous met les différents code d appel des classeurs ainsi que les timers pour que vous ayez déjà une idée de la complexité du problème après je pourrais éventuellement vous fournir les classeurs en partie

Sub Auto_open()
    Windows("Trade .xlsm").Activate
    Application.ScreenUpdating = False
    For i = 12 To 134
        Rows(i).Select
        'Range("NR" & i & ":QF" & i).ClearContents
    Next

    Application.ScreenUpdating = True
    Application.ScreenUpdating = False
    Chemin = "C:\Users\Public\Documents\Bourse jo" 'mettez ici le chemin ou se trouve vos fichiers"
    Workbooks.Open Filename:=Chemin & "\CotationParMinuteTrade.xlsm"
    Workbooks.Open Filename:=Chemin & "\CotationAu Quart-dheureTrade.xlsm"
    Windows("Trade .xlsm").Activate
End Sub



VBA project(cotationsParMinutetrade.xlsm)

Option Explicit

Private Sub Workbook_Open()
    Dim i As Long
    For i = 12 To 134
        Rows(i).Select
        Range("NR" & i & ":PC" & i).ClearContents
    Next
    c = 382
    T1 = 1
    Tempo1 = 1 / 24 / 60
    TempsInitial1 = "09:00:00" '= heure de démarrage
    TempsInitial1Num = Format(TempsInitial1, "0.00000")
    Application.OnTime TimeValue(TempsInitial1), Procedure:="RecupCotation1" '"09:00:00"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ArretCotation1
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(134, c)) = Range("A12:A134").Value
    Application.Wait Now + TimeValue("00:00:01")
    TempsInitial1Num = TempsInitial1Num + Tempo1
    If c >= 413 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


VBAPoject(CotationAu Quart-dheureTrade.xlsm)

Option Explicit

Private Sub Workbook_Open()
    Dim i As Long
    For i = 12 To 134
        Range(Cells(i, 413), Cells(i, 448)).ClearContents
    Next i
    d = 413
    T2 = 1
    Tempo2 = 15 / 24 / 60
    TempsInitial2 = "09:00:00" '= heure de démarrage - 1 intervalle de temps entre 2 relevés"
    TempsInitial2Num = Format(TempsInitial2, "0.00000")
    PremierPassage2 = True
    Application.OnTime TimeValue(TempsInitial2), Procedure:="RecupCotation2" '"09:15:00"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ArretCotation2
End Sub

  Public Durée2 As Date
    Public d As Long
    Public TempsInitial2 As Date
    Public TempsInitial2Num As Double
    Public T2
    Public Tempo2
    Public Bascule2 As Date
    Public PremierPassage2 As Boolean



Sub RecupCotation2()
    If T2 >= 4 Then
        T2 = 0
        TempsInitial2 = TempsInitial2 + "01:00:00"
        TempsInitial2Num = Format(TempsInitial2, "0.00000")
    End If
    Durée2 = Format(TempsInitial2Num + (T2 * Tempo2), "hh:mm:ss")
    T2 = T2 + 1
    Application.OnTime Durée2, "RecupCotation2"
    Range(Cells(12, d), Cells(134, d)) = Range("A12:A134").Value
    Application.Wait Now + TimeValue("00:00:01")
    If d >= 449 Then ArretCotation2 'N° de la première colonne vide (ou dernière colonne de la cotation au quart d'heure)
    d = d + 1
End Sub
Sub ArretCotation2()
    On Error Resume Next
    Application.OnTime Durée2, "RecupCotation2", , False
End Sub

Bonne journée

du coup la , je pense que c'est vraiment très trés complexe

Faire remonter les lignes en programmant

9 réponses

Discussions similaires