Optimisation boucle if vba
Résolu
Bonjour,
j'essaie de construire une macro sur ma feuille active me ramenant les valeurs de mes fonds presente sur une autre feuille en fonction du choix de l'identifiant que j'aurais fait dans ma Liste deroulante. j'ai utiliser la boucle if qui marche mais le problème est que j'ai plus de 190 fonds dans ma Liste déroulante et que ca me conduira à boucler à l'infini.
Existe-t-il une methode me permettant d'optimiser mon programme pour contourner ce problème? voici le code que j'ai utilisé:
EDIT : Ajout des balises de code
Je vous remercie de tout coeur pour l'aide que vous m'accorderai. cordialement
j'essaie de construire une macro sur ma feuille active me ramenant les valeurs de mes fonds presente sur une autre feuille en fonction du choix de l'identifiant que j'aurais fait dans ma Liste deroulante. j'ai utiliser la boucle if qui marche mais le problème est que j'ai plus de 190 fonds dans ma Liste déroulante et que ca me conduira à boucler à l'infini.
Existe-t-il une methode me permettant d'optimiser mon programme pour contourner ce problème? voici le code que j'ai utilisé:
Sub Remplir()
' feuille de calcul
' attribue des valeurs aux champs en fonction du choix du ticker dans la liste deroulante
If Cells(1, 2).Value = "TPXH FP Equity" Then
Range("B2").Value = Sheets("sheet1").Range("N17").Value
Range("B3").Value = Sheets("sheet1").Range("H17").Value
Range("D5:D900").Value = Sheets("sheet2").Range("A5:A900").Value
Range("E5:E900").Value = Sheets("sheet2").Range("B5:B900").Value
Range("F5:F900").Value = Sheets("sheet2").Range("C5:C900").Value
Range("I5:I900").Value = Sheets("sheet2").Range("A5:A900").Value
Range("J5:J900").Value = Sheets("sheet2").Range("G5:G900").Value
Range("K5:K900").Value = Sheets("sheet2").Range("H5:H900").Value
Range("P5:P900").Value = Sheets("sheet2").Range("K5:K900").Value
Range("Q5:Q900").Value = Sheets("sheet2").Range("L5:L900").Value
Range("S5:S900").Value = Sheets("sheet2").Range("N5:N900").Value
Range("T5:T900").Value = Sheets("sheet2").Range("O5:O900").Value
Range("W5:W900").Value = Sheets("sheet2").Range("R5:R900").Value
Range("X5:X900").Value = Sheets("sheet2").Range("S5:S900").Value
Range("Y5:Y900").Value = Sheets("sheet2").Range("T5:T900").Value
Range("AB5:AB900").Value = Sheets("sheet2").Range("W5:W900").Value
Range("AC5:AC900").Value = Sheets("sheet2").Range("X5:X900").Value
Range("AD5:AD900").Value = Sheets("sheet2").Range("Y5:Y900").Value
Range("AE5:AE900").Value = Sheets("sheet2").Range("Z5:Z900").Value
Range("AF5:AF900").Value = Sheets("sheet2").Range("AA5:AA900").Value
Else
If Cells(1, 2).Value = "EEA FP Equity" Then
Range("B2").Value = Sheets("sheet1").Range("N30").Value
Range("B3").Value = Sheets("sheet1").Range("H30").Value
Range("D5:D900").Value = Sheets("sheet2").Range("AE5:AE900").Value
Range("E5:E900").Value = Sheets("sheet2").Range("AF5:AF900").Value
Range("F5:F900").Value = Sheets("sheet2").Range("AG5:AG900").Value
Range("I5:I900").Value = Sheets("sheet2").Range("AJ5:AJ900").Value
Range("J5:J900").Value = Sheets("sheet2").Range("AK5:AK900").Value
Range("K5:K900").Value = Sheets("sheet2").Range("AL5:AL900").Value
Range("P5:P900").Value = Sheets("sheet2").Range("AO5:AO900").Value
Range("Q5:Q900").Value = Sheets("sheet2").Range("AP5:AP900").Value
Range("S5:S900").Value = Sheets("sheet2").Range("AR5:AR900").Value
Range("T5:T900").Value = Sheets("sheet2").Range("AS5:AS900").Value
Range("W5:W900").Value = Sheets("sheet2").Range("AV5:AV900").Value
Range("X5:X900").Value = Sheets("sheet2").Range("AW5:AW900").Value
Range("Y5:Y900").Value = Sheets("sheet2").Range("T5:T900").Value
Range("AB5:AB900").Value = Sheets("sheet2").Range("AX5:AX900").Value
Range("AC5:AC900").Value = Sheets("sheet2").Range("BA5:BA900").Value
Range("AD5:AD900").Value = Sheets("sheet2").Range("BB5:BB900").Value
Range("AE5:AE900").Value = Sheets("sheet2").Range("BC5:BC900").Value
Range("AF5:AF900").Value = Sheets("sheet2").Range("BD5:BD900").Value
Else
MsgBox " il n'y a pas de correspondance"
End If
End If
End sub
EDIT : Ajout des balises de code
Je vous remercie de tout coeur pour l'aide que vous m'accorderai. cordialement
8 réponses
-
Bonjour Laetitia, bonjour le forum,
Difficile d'optimiser ce code sans avoir ton fichier sous les yeux... Regarde du coté du coté de : https://www.cjoint.com/
ou d'un quelconque autre hébergeur de fichiers pour ce faire...
-
Bonjour thau theme, merci pour l'attention, voici le lien de mon fichier
https://www.cjoint.com/c/HGnmI5F6XYi
il s'agit de la feuille 3, la liste deroulante est en B2. pour l'instant j'ai des donnees que sur deux ticker ( TPXTHE ,EEA FP) je completerai par la suite dans la fiche 2 pour tout les fonds.
-
-
Contributeurbonjour, moi je ferais ainsi:
Option Explicit Sub Remplir() ' feuille de calcul ' attribue des valeurs aux champs en fonction du choix du ticker dans la liste deroulante Const tickers As String = "TPXH FP Equity,EEA FP Equity" Dim choix() As String, dests() As String, dest() As String Dim i As Integer choix = split(tickers, ",") For i = 0 To UBound(choix) If Cells(1, 2).Value = choix(i) Then deplacer (i) Exit Sub End If Next i MsgBox " il n'y a pas de correspondance" End Sub Private Sub deplacer(n As Integer) Const destinations As String = "N17,H17;N30,H30" Dim destsss() As String, dests() As String destsss = split(destinations, ";") dests = split(destsss(n), ",") Range("B2").Value = Sheets("sheet1").Range(dests(0)).Value Range("B3").Value = Sheets("sheet1").Range(dests(1)).Value End Sub
à toi de completer pour les 18 autres copies (agrandir la constante "destination", et completer la sub "deplacer") -
Re,
Oui, sauf que ce n'est pas 19 mais 190 fonds dont il s'agit... Ça simplifiera toujours, tu me diras...
Je pensais plutôt, si l'intervalle entre les fonds était fixe, utiliser une boucle mais sans rien écrire en dur. C'est pour cela que je demandais a voir le fichier...
-
Merci thautheme, yg-be pour l'attention, voici le lien de mon fichier
https://www.cjoint.com/c/HGnmI5F6XYi
il s'agit de la feuille 3, la liste deroulante est en B2. pour l'instant j'ai des donnees que sur deux ticker ( TPXTHE ,EEA FP) je completerai par la suite dans la fiche 2 pour tout les fonds.
cordialement -
Bonjour,
Suggestion :
Décompose ton code en plusieurs petites procédures :
Option Explicit Public Const CTE_TPXH = "TPXH FP Equity" Public Const CTE_AXFI = "AXFI FP Equity" Public Const CTE_EEA = "EEA FP Equity" ' Sub Remplir() Dim ValeurCible As String Dim SectionCible As String ValeurCible = Cells(1, 2).Value SectionCible = Mid(ValeurCible, 1, 2) ' Prends les 2 premiers caractères (i.e. ce pourrait être les 3 premiers...) Select Case SectionCible Case "TP" Call Assignation_100(ValeurCible) Case "AX" Call Assignation_100(ValeurCible) Case "EE" Call Assignation_300(ValeurCible) ' Etc ... Case Else MsgBox " il n'y a pas de correspondance" End Select ' la suite ... End Sub ' Private Sub Assignation_100(ByVal pValeur As String) Select Case pValeur Case CTE_TPXH Assignation_101 Case CTE_... Assignation_102 ' Etc ... Case Else MsgBox " il n'y a pas de correspondance" End Select End Sub ' Private Sub Assignation_200(ByVal pValeur As String) Select Case pValeur Case CTE_AXFI Assignation_201 Case CTE_... Assignation_202 ' Etc ... Case Else MsgBox " il n'y a pas de correspondance" End Select End Sub ' Private Sub Assignation_300(ByVal pValeur As String) Select Case pValeur Case CTE_EEA Assignation_301 ' Etc ... Case Else MsgBox " il n'y a pas de correspondance" End Select End Sub ' Private Sub Assignation_101() Range("B2").Value = Sheets("sheet1").Range("N17").Value Range("B3").Value = Sheets("sheet1").Range("H17").Value Range("D5:D900").Value = Sheets("sheet2").Range("A5:A900").Value Range("E5:E900").Value = Sheets("sheet2").Range("B5:B900").Value Range("F5:F900").Value = Sheets("sheet2").Range("C5:C900").Value Range("I5:I900").Value = Sheets("sheet2").Range("A5:A900").Value Range("J5:J900").Value = Sheets("sheet2").Range("G5:G900").Value Range("K5:K900").Value = Sheets("sheet2").Range("H5:H900").Value Range("P5:P900").Value = Sheets("sheet2").Range("K5:K900").Value Range("Q5:Q900").Value = Sheets("sheet2").Range("L5:L900").Value Range("S5:S900").Value = Sheets("sheet2").Range("N5:N900").Value Range("T5:T900").Value = Sheets("sheet2").Range("O5:O900").Value Range("W5:W900").Value = Sheets("sheet2").Range("R5:R900").Value Range("X5:X900").Value = Sheets("sheet2").Range("S5:S900").Value Range("Y5:Y900").Value = Sheets("sheet2").Range("T5:T900").Value Range("AB5:AB900").Value = Sheets("sheet2").Range("W5:W900").Value Range("AC5:AC900").Value = Sheets("sheet2").Range("X5:X900").Value Range("AD5:AD900").Value = Sheets("sheet2").Range("Y5:Y900").Value Range("AE5:AE900").Value = Sheets("sheet2").Range("Z5:Z900").Value Range("AF5:AF900").Value = Sheets("sheet2").Range("AA5:AA900").Value End Sub ' Private Sub Assignation_201() ' ... End Sub ' Private Sub Assignation_301() Range("B2").Value = Sheets("sheet1").Range("N30").Value Range("B3").Value = Sheets("sheet1").Range("H30").Value Range("D5:D900").Value = Sheets("sheet2").Range("AE5:AE900").Value Range("E5:E900").Value = Sheets("sheet2").Range("AF5:AF900").Value Range("F5:F900").Value = Sheets("sheet2").Range("AG5:AG900").Value Range("I5:I900").Value = Sheets("sheet2").Range("AJ5:AJ900").Value Range("J5:J900").Value = Sheets("sheet2").Range("AK5:AK900").Value Range("K5:K900").Value = Sheets("sheet2").Range("AL5:AL900").Value Range("P5:P900").Value = Sheets("sheet2").Range("AO5:AO900").Value Range("Q5:Q900").Value = Sheets("sheet2").Range("AP5:AP900").Value Range("S5:S900").Value = Sheets("sheet2").Range("AR5:AR900").Value Range("T5:T900").Value = Sheets("sheet2").Range("AS5:AS900").Value Range("W5:W900").Value = Sheets("sheet2").Range("AV5:AV900").Value Range("X5:X900").Value = Sheets("sheet2").Range("AW5:AW900").Value Range("Y5:Y900").Value = Sheets("sheet2").Range("T5:T900").Value Range("AB5:AB900").Value = Sheets("sheet2").Range("AX5:AX900").Value Range("AC5:AC900").Value = Sheets("sheet2").Range("BA5:BA900").Value Range("AD5:AD900").Value = Sheets("sheet2").Range("BB5:BB900").Value Range("AE5:AE900").Value = Sheets("sheet2").Range("BC5:BC900").Value Range("AF5:AF900").Value = Sheets("sheet2").Range("BD5:BD900").Value End Sub
K -
Bonjour le fil, bonjour le forum,
Pour la partie des copier/coller à Tester :Sub Remplir() Dim S1 As Worksheet Dim S2 As Worksheet Dim S3 As Worksheet Dim TV1 As Variant Dim V As String Dim LI As Long Dim RC As Range Set S1 = Worksheets("Sheet1") Set S2 = Worksheets("Sheet2") Set S3 = Worksheets("Sheet3 (2)") S3.Rows("2:" & Application.Rows.Count).Delete V = S3.Range("B1").Value TV1 = S1.Range("A7").CurrentRegion For LI = 1 To UBound(TV1, 1) If TV1(LI, 2) = V Then S3.Range("B2").Value = TV1(LI, 14) S3.Range("B3").Value = TV1(LI, 8) Exit For End If Next LI Set RC = S2.Rows(3).Find(V, S2.Cells(3, Application.Columns.Count), xlValues, xlWhole) If Not RC Is Nothing Then RC.Resize(1000, 27).Copy S3.Range("D3") S3.Columns("M:M").Insert S3.Columns("M:M").Insert End Sub
Pour la partie formules, il faut absolument éviter les Select inutiles ! C'est une règle d'or VBA.
À vérifier :Sub Remplir() Dim I As Integer Dim K As Integer Dim M As Integer Dim O As Integer Dim Q As Integer Set S3 = Worksheets("Sheet3 (2)") S3.Range("AJ2").FormulaR1C1 = "=COUNT(R[3]C:R[895]C)" S3.Range("P2").FormulaR1C1 = "=COUNT(R[3]C:R[897]C)" S3.Range("Q3").FormulaR1C1 = "=AVERAGE(R[3]C:R[895]C)+1.96*STDEV(R[3]C:R[895]C)" ' calcul de la moyenne si S3.Range("Q2").FormulaR1C1 = "=AVERAGEIF(R[3]C:R[895]C,""<""&R[1]C)" For I = 5 To 900 If I < S3.Range("AJ2").Value Then S3.Range("AJ5:AJ900").Value = S3.Range("P5:P900").Value: Exit For Next I ' calcul average BID ASK SPREAD % S3.Range("AK5:AK900").FormulaR1C1 = _ "=IF(VLOOKUP(RC[-1],RC[-21]:R[892]C[-20],2,FALSE)>=R3C17,R2C17,VLOOKUP(RC[-1],RC[-21]:R[892]C[-20],2,FALSE))" ' dates volume ' nombre de lignes dates volume S3.Range("AM2").FormulaR1C1 = "=COUNT(R[3]C:R[947]C)+4" For K = 5 To 900 If K < S3.Range("AM2").Value Then S3.Range("AM5:AM900").Value = S3.Range("S5:S900").Value: Exit For Next K ' calcul volume S3.Range("AN5:AN900").FormulaR1C1 = _ "=VLOOKUP(RC[-1],RC[-21]:R[892]C[-20],2,FALSE)*VLOOKUP(RC[-1],RC[-31]:R[895]C[-30],2,FALSE)/1000" 'comptage S3.Range("AR2").FormulaR1C1 = "=COUNT(C[-35])+4+1" ' date case AR For M = 5 To 900 If M < S3.Range("AR2").Value Then S3.Range("AR5:AR900").Value = S3.Range("I5:I900").Value: Exit For Next M S3.Range("AS5:AS900").FormulaR1C1 = _ "=IF(VLOOKUP(RC[-1],C[-36]:C[-34],3,FALSE)=R9C1,VLOOKUP(R[-1]C[-1],C[-36]:C[-34],3,FALSE),VLOOKUP(RC[-1],C[-36]:C[-34],3,FALSE))" S3.Range("AT5:AT900").FormulaR1C1 = _ "=IF(VLOOKUP(RC[-2],C[-23]:C[-21],3,TRUE)="""",""impo"",VLOOKUP(RC[-2],C[-23]:C[-21],3,TRUE))" S3.Range("AU6:AU900").FormulaR1C1 = "=RC[-2]/R[-1]C[-2]-1" S3.Range("AV6:AV900").FormulaR1C1 = "=RC[-2]/R[-1]C[-2]-1" S3.Range("AX2").FormulaR1C1 = "=COUNT(C[-33])+2+1" For O = 5 To 900 If O < Range("AX2").Value Then S3.Range("AX5:AX900").Value = S3.Range("D5:D900").Value: Exit For Next O ' NAV S3.Range("AY5:AY900").FormulaR1C1 = _ "=IF(VLOOKUP(RC[-1],C[-47]:C[-45],2,FALSE)=R9C1,VLOOKUP(R[-1]C[-1],C[-47]:C[-45],2,FALSE),VLOOKUP(RC[-1],C[-47]:C[-45],2,FALSE))" ' Price S3.Range("AZ5:AZ900").FormulaR1C1 = _ "=IF(VLOOKUP(RC[-2],C[-48]:C[-46],3,FALSE)=R9C1,VLOOKUP(R[-1]C[-2],C[-48]:C[-46],3,FALSE),VLOOKUP(RC[-2],C[-48]:C[-46],3,FALSE))" ' discount S3.Range("BA6:BA900").FormulaR1C1 = "=IFERROR(IF(RC[-1]/RC[-2]<1,RC[-1]/RC[-2]-1,0),"""")" ' Premium S3.Range("BB6:BB900").FormulaR1C1 = "=IFERROR(IF(RC[-2]/RC[-3]>1,RC[-2]/RC[-3]-1,0),"""")" ' ETF S3.Range("BE5").FormulaR1C1 = "=RC[-12]/R5C45*100" S3.Range("BE6:BE900").FormulaR1C1 = "=R[-1]C*(1+RC[-10])" ' index S3.Range("BF5").FormulaR1C1 = "=RC[-12]/RC[-12]*100" S3.Range("BF6:BF900").FormulaR1C1 = "=R[-1]C/(1+RC[-10])" S3.Range("BG260:BG900").FormulaR1C1 = "=STDEV(R[-254]C[-12]:RC[-12])*SQRT(260)" S3.Range("BH260:BH900").FormulaR1C1 = "=STDEV(R[-254]C[-12]:RC[-12])*SQRT(260)" ' correllation S3.Range("BI24:BI900").FormulaR1C1 = "=CORREL(R[-18]C[-14]:RC[-14],R[-18]C[-13]:RC[-13])" ' asset grow S3.Range("BL2").FormulaR1C1 = "=COUNT(C[-36])+4+1" For Q = 5 To 900 If Q < S3.Range("AX2").Value Then S3.Range("BL5:BL900").Value = S3.Range("AB5:AB900").Value: Exit For Next Q S3.Range("AC2").FormulaR1C1 = "=MATCH(TRUE,INDEX((R[3]C:R[28]C<>0),0),0)+4" S3.Range("AD2").FormulaR1C1 = "=MATCH(TRUE,INDEX((R[3]C:R[28]C<>0),0),0)+4" S3.Range("AE2").FormulaR1C1 = "=MATCH(TRUE,INDEX((R[3]C:R[28]C<>0),0),0)+4" S3.Range("AF2").FormulaR1C1 = "=MATCH(TRUE,INDEX((R[3]C:R[28]C<>0),0),0)+4" S3.Range("BM3").FormulaR1C1 = "=+INDIRECT(""y""&R[-1]C[-36])" 'premiere ligne S3.Range("BM5").FormulaR1C1 = _ "=IF(VLOOKUP(RC[-1],C[-37]:C[-33],2,FALSE)="""",R3C65,VLOOKUP(RC[-1],C[-37]:C[-33],2,FALSE))" S3.Range("BM6:BM900").FormulaR1C1 = _ "=IF(VLOOKUP(RC[-1],C[-37]:C[-33],2,FALSE)="""",R[-1]C65,VLOOKUP(RC[-1],C[-37]:C[-33],2,FALSE))" ' shares S3.Range("BN3").FormulaR1C1 = "=INDIRECT(""AB""&R[-1]C[-34])" S3.Range("BN5") = _ "=IF(VLOOKUP(RC[-2],C[-38]:C[-34],5,FALSE)="""",R3C66,VLOOKUP(RC[-2],C[-38]:C[-34],5,FALSE))" S3.Range("BN6:BN900").FormulaR1C1 = _ "=IF(VLOOKUP(RC[-2],C[-38]:C[-34],5,FALSE)="""",R[-1]C66,VLOOKUP(RC[-2],C[-38]:C[-34],5,FALSE))" ' turnover S3.Range("BO3").FormulaR1C1 = "=INDIRECT(""z""&R[-1]C[-37])" S3.Range("BO5:BO900").FormulaR1C1 = _ "=IF(VLOOKUP(RC[-3],C[-39]:C[-35],3,FALSE)="""",R3C67,VLOOKUP(RC[-3],C[-39]:C[-35],3,FALSE))" ' ETF S3.Range("BP3").FormulaR1C1 = "=INDIRECT(""AA""&R[-1]C[-37])" S3.Range("BP5:BP900").FormulaR1C1 = _ "=+IFERROR(IF(VLOOKUP(RC[-4],C[-59]:C[-57],3,FALSE)/VLOOKUP(RC[-4],C[-59]:C[-57],2,FALSE)<1,VLOOKUP(RC[-4],C[-59]:C[-57],3,FALSE)/VLOOKUP(RC[-4],C[-59]:C[-57],2,FALSE)-1,""""),"""")" ' index S3.Range("BQ5:BQ900").FormulaR1C1 = _ "=+IFERROR(IF(VLOOKUP(RC[-5],C[-60]:C[-57],3,FALSE)/VLOOKUP(RC[-5],C[-60]:C[-57],2,FALSE)>1,VLOOKUP(RC[-5],C[-60]:C[-57],3,FALSE)/VLOOKUP(RC[-5],C[-60]:C[-57],2,FALSE)-1,""""),"""")" ' matrice de date S3.Range("BT4").FormulaR1C1 = "=R[2]C[-71]" S3.Range("BT5:BT12").FormulaR1C1 = "=EOMONTH(R[-1]C,-MONTH(R[-1]C))" S3.Range("BS4:BS12").FormulaR1C1 = "=RC[1]+1" S3.Range("BU4:BU11").FormulaR1C1 = "=TEXT(R[1]C[-2],""yyyymmdd"")" S3.Range("BV4:BV12").FormulaR1C1 = "=TEXT(RC[-2],""yyyymmdd"")" S3.Range("BT14").FormulaR1C1 = _ "=IF(WEEKDAY(R[-8]C[-71])=1,R[-8]C[-71]-2,IF(WEEKDAY(R[-8]C[-71])=7,R[-8]C[-71]-1,R[-8]C[-71]))" S3.Range("BT15").FormulaR1C1 = "=EOMONTH(R6C1,-12)" S3.Range("BT16").FormulaR1C1 = "=EOMONTH(R6C1,-24)" S3.Range("BT17").FormulaR1C1 = "=EOMONTH(R6C1,-36)" S3.Range("BT18").FormulaR1C1 = "=EOMONTH(R6C1,-48)" S3.Range("BT19").FormulaR1C1 = "=EOMONTH(R6C1,-60)" S3.Range("BS14").FormulaR1C1 = "=EOMONTH(RC[1],-MONTH(RC[1]))+1" S3.Range("BS15:BS19").FormulaR1C1 = "=RC[1]+1" S3.Range("BU14").FormulaR1C1 = "=TEXT(RC[-2]-1,""yyyymmdd"")" S3.Range("BU15:BU19").FormulaR1C1 = "=TEXT(RC[-1],""yyyymmdd"")" S3.Range("BV14:BV19").FormulaR1C1 = "=TEXT(RC[-2],""yyyymmdd"")" S3.Range("BT23").FormulaR1C1 = "=R[-18]C[-71]" S3.Range("BU23").FormulaR1C1 = "=EOMONTH(RC[-1],7)+1" S3.Range("BV23").FormulaR1C1 = "=DATE(YEAR(RC[-2])+1,1,1)" S3.Range("BX23").FormulaR1C1 = "=R[-20]C[-74]" S3.Range("BX24").FormulaR1C1 = "=R[-23]C[-74]" S3.Range("BY24").FormulaR1C1 = "=R[-22]C[-75]" S3.Range("BS26").FormulaR1C1 = "=DATE(YEAR(R[-3]C[1])+1,1,1)" S3.Range("BT25").FormulaR1C1 = "=DATE(YEAR(R[-2]C)+1,1,1)" S3.Range("BT32").FormulaR1C1 = "=R[-26]C[-71]" S3.Range("BT26").FormulaR1C1 = "=R[6]C" S3.Range("BT31").FormulaR1C1 = "=EOMONTH(R[1]C,-MONTH(R[1]C))" S3.Range("BT30").FormulaR1C1 = "=EOMONTH(R[1]C,-12)" S3.Range("BT29").FormulaR1C1 = "=EOMONTH(R[1]C,-12)" S3.Range("BT28").FormulaR1C1 = "=EOMONTH(R[1]C,-12)" S3.Range("BT27").FormulaR1C1 = "=EOMONTH(R[1]C,-12)" S3.Range("BS29:BS32").FormulaR1C1 = "=R[-1]C[1]" S3.Range("BU26:BU32").FormulaR1C1 = "=TEXT(RC[-2],""yyyymmdd"")" S3.Range("BV26:BV32").FormulaR1C1 = "=TEXT(RC[-2],""yyyymmdd"")" S3.Range("BW27").FormulaR1C1 = "=""since""&TEXT(R[-1]C[-4],""yyyy-mm"")" S3.Range("BX2").FormulaR1C1 = "=R[1]C[-74]" MsgBox "Fait !" End Sub
Je n'ai pas compris pourquoi tu fais des double boucles avec une seule valeur dans la seconde ?!...
Le code complet :Sub Remplir() Dim S1 As Worksheet Dim S2 As Worksheet Dim S3 As Worksheet Dim TV1 As Variant Dim V As String Dim LI As Long Dim RC As Range Dim I As Integer Dim K As Integer Dim M As Integer Dim O As Integer Dim Q As Integer Set S1 = Worksheets("Sheet1") Set S2 = Worksheets("Sheet2") Set S3 = Worksheets("Sheet3 (2)") S3.Rows("2:" & Application.Rows.Count).Delete V = S3.Range("B1").Value TV1 = S1.Range("A7").CurrentRegion For LI = 1 To UBound(TV1, 1) If TV1(LI, 2) = V Then S3.Range("B2").Value = TV1(LI, 14) S3.Range("B3").Value = TV1(LI, 8) Exit For End If Next LI Set RC = S2.Rows(3).Find(V, S2.Cells(3, Application.Columns.Count), xlValues, xlWhole) If Not RC Is Nothing Then RC.Resize(1000, 27).Copy S3.Range("D3") S3.Columns("M:M").Insert S3.Columns("M:M").Insert 'à vérifier S3.Range("AJ2").FormulaR1C1 = "=COUNT(R[3]C:R[895]C)" S3.Range("P2").FormulaR1C1 = "=COUNT(R[3]C:R[897]C)" S3.Range("Q3").FormulaR1C1 = "=AVERAGE(R[3]C:R[895]C)+1.96*STDEV(R[3]C:R[895]C)" ' calcul de la moyenne si S3.Range("Q2").FormulaR1C1 = "=AVERAGEIF(R[3]C:R[895]C,""<""&R[1]C)" For I = 5 To 900 If I < S3.Range("AJ2").Value Then S3.Range("AJ5:AJ900").Value = S3.Range("P5:P900").Value: Exit For Next I ' calcul average BID ASK SPREAD % S3.Range("AK5:AK900").FormulaR1C1 = _ "=IF(VLOOKUP(RC[-1],RC[-21]:R[892]C[-20],2,FALSE)>=R3C17,R2C17,VLOOKUP(RC[-1],RC[-21]:R[892]C[-20],2,FALSE))" ' dates volume ' nombre de lignes dates volume S3.Range("AM2").FormulaR1C1 = "=COUNT(R[3]C:R[947]C)+4" For K = 5 To 900 If K < S3.Range("AM2").Value Then S3.Range("AM5:AM900").Value = S3.Range("S5:S900").Value: Exit For Next K ' calcul volume S3.Range("AN5:AN900").FormulaR1C1 = _ "=VLOOKUP(RC[-1],RC[-21]:R[892]C[-20],2,FALSE)*VLOOKUP(RC[-1],RC[-31]:R[895]C[-30],2,FALSE)/1000" 'comptage S3.Range("AR2").FormulaR1C1 = "=COUNT(C[-35])+4+1" ' date case AR For M = 5 To 900 If M < S3.Range("AR2").Value Then S3.Range("AR5:AR900").Value = S3.Range("I5:I900").Value: Exit For Next M S3.Range("AS5:AS900").FormulaR1C1 = _ "=IF(VLOOKUP(RC[-1],C[-36]:C[-34],3,FALSE)=R9C1,VLOOKUP(R[-1]C[-1],C[-36]:C[-34],3,FALSE),VLOOKUP(RC[-1],C[-36]:C[-34],3,FALSE))" S3.Range("AT5:AT900").FormulaR1C1 = _ "=IF(VLOOKUP(RC[-2],C[-23]:C[-21],3,TRUE)="""",""impo"",VLOOKUP(RC[-2],C[-23]:C[-21],3,TRUE))" S3.Range("AU6:AU900").FormulaR1C1 = "=RC[-2]/R[-1]C[-2]-1" S3.Range("AV6:AV900").FormulaR1C1 = "=RC[-2]/R[-1]C[-2]-1" S3.Range("AX2").FormulaR1C1 = "=COUNT(C[-33])+2+1" For O = 5 To 900 If O < Range("AX2").Value Then S3.Range("AX5:AX900").Value = S3.Range("D5:D900").Value: Exit For Next O ' NAV S3.Range("AY5:AY900").FormulaR1C1 = _ "=IF(VLOOKUP(RC[-1],C[-47]:C[-45],2,FALSE)=R9C1,VLOOKUP(R[-1]C[-1],C[-47]:C[-45],2,FALSE),VLOOKUP(RC[-1],C[-47]:C[-45],2,FALSE))" ' Price S3.Range("AZ5:AZ900").FormulaR1C1 = _ "=IF(VLOOKUP(RC[-2],C[-48]:C[-46],3,FALSE)=R9C1,VLOOKUP(R[-1]C[-2],C[-48]:C[-46],3,FALSE),VLOOKUP(RC[-2],C[-48]:C[-46],3,FALSE))" ' discount S3.Range("BA6:BA900").FormulaR1C1 = "=IFERROR(IF(RC[-1]/RC[-2]<1,RC[-1]/RC[-2]-1,0),"""")" ' Premium S3.Range("BB6:BB900").FormulaR1C1 = "=IFERROR(IF(RC[-2]/RC[-3]>1,RC[-2]/RC[-3]-1,0),"""")" ' ETF S3.Range("BE5").FormulaR1C1 = "=RC[-12]/R5C45*100" S3.Range("BE6:BE900").FormulaR1C1 = "=R[-1]C*(1+RC[-10])" ' index S3.Range("BF5").FormulaR1C1 = "=RC[-12]/RC[-12]*100" S3.Range("BF6:BF900").FormulaR1C1 = "=R[-1]C/(1+RC[-10])" S3.Range("BG260:BG900").FormulaR1C1 = "=STDEV(R[-254]C[-12]:RC[-12])*SQRT(260)" S3.Range("BH260:BH900").FormulaR1C1 = "=STDEV(R[-254]C[-12]:RC[-12])*SQRT(260)" ' correllation S3.Range("BI24:BI900").FormulaR1C1 = "=CORREL(R[-18]C[-14]:RC[-14],R[-18]C[-13]:RC[-13])" ' asset grow S3.Range("BL2").FormulaR1C1 = "=COUNT(C[-36])+4+1" For Q = 5 To 900 If Q < S3.Range("AX2").Value Then S3.Range("BL5:BL900").Value = S3.Range("AB5:AB900").Value: Exit For Next Q S3.Range("AC2").FormulaR1C1 = "=MATCH(TRUE,INDEX((R[3]C:R[28]C<>0),0),0)+4" S3.Range("AD2").FormulaR1C1 = "=MATCH(TRUE,INDEX((R[3]C:R[28]C<>0),0),0)+4" S3.Range("AE2").FormulaR1C1 = "=MATCH(TRUE,INDEX((R[3]C:R[28]C<>0),0),0)+4" S3.Range("AF2").FormulaR1C1 = "=MATCH(TRUE,INDEX((R[3]C:R[28]C<>0),0),0)+4" S3.Range("BM3").FormulaR1C1 = "=+INDIRECT(""y""&R[-1]C[-36])" 'premiere ligne S3.Range("BM5").FormulaR1C1 = _ "=IF(VLOOKUP(RC[-1],C[-37]:C[-33],2,FALSE)="""",R3C65,VLOOKUP(RC[-1],C[-37]:C[-33],2,FALSE))" S3.Range("BM6:BM900").FormulaR1C1 = _ "=IF(VLOOKUP(RC[-1],C[-37]:C[-33],2,FALSE)="""",R[-1]C65,VLOOKUP(RC[-1],C[-37]:C[-33],2,FALSE))" ' shares S3.Range("BN3").FormulaR1C1 = "=INDIRECT(""AB""&R[-1]C[-34])" S3.Range("BN5") = _ "=IF(VLOOKUP(RC[-2],C[-38]:C[-34],5,FALSE)="""",R3C66,VLOOKUP(RC[-2],C[-38]:C[-34],5,FALSE))" S3.Range("BN6:BN900").FormulaR1C1 = _ "=IF(VLOOKUP(RC[-2],C[-38]:C[-34],5,FALSE)="""",R[-1]C66,VLOOKUP(RC[-2],C[-38]:C[-34],5,FALSE))" ' turnover S3.Range("BO3").FormulaR1C1 = "=INDIRECT(""z""&R[-1]C[-37])" S3.Range("BO5:BO900").FormulaR1C1 = _ "=IF(VLOOKUP(RC[-3],C[-39]:C[-35],3,FALSE)="""",R3C67,VLOOKUP(RC[-3],C[-39]:C[-35],3,FALSE))" ' ETF S3.Range("BP3").FormulaR1C1 = "=INDIRECT(""AA""&R[-1]C[-37])" S3.Range("BP5:BP900").FormulaR1C1 = _ "=+IFERROR(IF(VLOOKUP(RC[-4],C[-59]:C[-57],3,FALSE)/VLOOKUP(RC[-4],C[-59]:C[-57],2,FALSE)<1,VLOOKUP(RC[-4],C[-59]:C[-57],3,FALSE)/VLOOKUP(RC[-4],C[-59]:C[-57],2,FALSE)-1,""""),"""")" ' index S3.Range("BQ5:BQ900").FormulaR1C1 = _ "=+IFERROR(IF(VLOOKUP(RC[-5],C[-60]:C[-57],3,FALSE)/VLOOKUP(RC[-5],C[-60]:C[-57],2,FALSE)>1,VLOOKUP(RC[-5],C[-60]:C[-57],3,FALSE)/VLOOKUP(RC[-5],C[-60]:C[-57],2,FALSE)-1,""""),"""")" ' matrice de date S3.Range("BT4").FormulaR1C1 = "=R[2]C[-71]" S3.Range("BT5:BT12").FormulaR1C1 = "=EOMONTH(R[-1]C,-MONTH(R[-1]C))" S3.Range("BS4:BS12").FormulaR1C1 = "=RC[1]+1" S3.Range("BU4:BU11").FormulaR1C1 = "=TEXT(R[1]C[-2],""yyyymmdd"")" S3.Range("BV4:BV12").FormulaR1C1 = "=TEXT(RC[-2],""yyyymmdd"")" S3.Range("BT14").FormulaR1C1 = _ "=IF(WEEKDAY(R[-8]C[-71])=1,R[-8]C[-71]-2,IF(WEEKDAY(R[-8]C[-71])=7,R[-8]C[-71]-1,R[-8]C[-71]))" S3.Range("BT15").FormulaR1C1 = "=EOMONTH(R6C1,-12)" S3.Range("BT16").FormulaR1C1 = "=EOMONTH(R6C1,-24)" S3.Range("BT17").FormulaR1C1 = "=EOMONTH(R6C1,-36)" S3.Range("BT18").FormulaR1C1 = "=EOMONTH(R6C1,-48)" S3.Range("BT19").FormulaR1C1 = "=EOMONTH(R6C1,-60)" S3.Range("BS14").FormulaR1C1 = "=EOMONTH(RC[1],-MONTH(RC[1]))+1" S3.Range("BS15:BS19").FormulaR1C1 = "=RC[1]+1" S3.Range("BU14").FormulaR1C1 = "=TEXT(RC[-2]-1,""yyyymmdd"")" S3.Range("BU15:BU19").FormulaR1C1 = "=TEXT(RC[-1],""yyyymmdd"")" S3.Range("BV14:BV19").FormulaR1C1 = "=TEXT(RC[-2],""yyyymmdd"")" S3.Range("BT23").FormulaR1C1 = "=R[-18]C[-71]" S3.Range("BU23").FormulaR1C1 = "=EOMONTH(RC[-1],7)+1" S3.Range("BV23").FormulaR1C1 = "=DATE(YEAR(RC[-2])+1,1,1)" S3.Range("BX23").FormulaR1C1 = "=R[-20]C[-74]" S3.Range("BX24").FormulaR1C1 = "=R[-23]C[-74]" S3.Range("BY24").FormulaR1C1 = "=R[-22]C[-75]" S3.Range("BS26").FormulaR1C1 = "=DATE(YEAR(R[-3]C[1])+1,1,1)" S3.Range("BT25").FormulaR1C1 = "=DATE(YEAR(R[-2]C)+1,1,1)" S3.Range("BT32").FormulaR1C1 = "=R[-26]C[-71]" S3.Range("BT26").FormulaR1C1 = "=R[6]C" S3.Range("BT31").FormulaR1C1 = "=EOMONTH(R[1]C,-MONTH(R[1]C))" S3.Range("BT30").FormulaR1C1 = "=EOMONTH(R[1]C,-12)" S3.Range("BT29").FormulaR1C1 = "=EOMONTH(R[1]C,-12)" S3.Range("BT28").FormulaR1C1 = "=EOMONTH(R[1]C,-12)" S3.Range("BT27").FormulaR1C1 = "=EOMONTH(R[1]C,-12)" S3.Range("BS29:BS32").FormulaR1C1 = "=R[-1]C[1]" S3.Range("BU26:BU32").FormulaR1C1 = "=TEXT(RC[-2],""yyyymmdd"")" S3.Range("BV26:BV32").FormulaR1C1 = "=TEXT(RC[-2],""yyyymmdd"")" S3.Range("BW27").FormulaR1C1 = "=""since""&TEXT(R[-1]C[-4],""yyyy-mm"")" S3.Range("BX2").FormulaR1C1 = "=R[1]C[-74]" MsgBox "Fait !" End Sub
-
Contributeurje pense que tu es partie sur une fausse piste (moi aussi, avec ma suggestion en #2).
avant de coder, demande-toi ce que le programme doit faire.
moi, je vois que le programme doit toujours copier vers la même destination.
la source, elle, change, mais il semble que le programme peut retrouver la source en cherchant où se trouve le nom de la valeur.
par exemple, le programme peut rechercher dans quelle ligne se trouve la valeur en colonne B de Sheet1, et en ligne 3 de Sheet2. le programme pourra ensuite agit en fonction de cela.
en suivant ce genre de logique, tu n'auras pas à écrire un énorme programme plein de répétitions. -
Bonjour le forum,
je vous fais un retour comme prévu, grand merci pour votre attention et vos suggestions ( qui m'ont donner un appercu de comment je pourrai aborder d'eventuels sujets avec la même problématique ). Thautheme , ton programme marche à merveille merci pour le temps accordé. Kalissi et Yg_be vous programme m'ont permis d'agrandir mon repertoire, je les ai appliqué à d'autres analyses et j'ai obtenu les résultats escomptés.
Merci encore et à bientot
