Questo sito utilizza cookies solo per scopi di autenticazione sul sito e nient'altro. Nessuna informazione personale viene tracciata. Leggi l'informativa sui cookies.
Username: Password: oppure
Visual Basic 6 - Scrivere 2 numeri secondo una matrice di 132 combinazioni e copiare un output su una serie di celle in fx di 1 griglia
Forum - Visual Basic 6 - Scrivere 2 numeri secondo una matrice di 132 combinazioni e copiare un output su una serie di celle in fx di 1 griglia

Avatar
ocheloso (Normal User)
Newbie


Messaggi: 1
Iscritto: 29/04/2016

Segnala al moderatore
Postato alle 15:26
Venerdì, 29/04/2016
Buongiorno a tutti,

dovrei rendere più semplice una macro, perchè ho il messaggio di errore “routine troppo grande”, magari inserendo funzioni o altre sub routine, ma essendo poco più che neofita ho bisogno del vostro supporto

La macro è semplice al di là di poche altre operazioni, esegue per 132 volte queste operazioni:

•    Scrive in due celle dei numeri secondo una matrice e una certa combinazione; nella prima cella numeri da 15 a 70 con passo A (=5) e nella seconda cella numeri da 30 a 130 con passo B (=10) in modo da ottenere appunto una matrice di 132 combinazioni.
•    Per ognuna delle 132 combinazioni di numeri, ogni volta si fa girare una macro che calcola dei dati e li copia in un foglio del file
•    Il risultato della macro si incolla successivamente in un altro file che produce un nuovo risultato e il risultato di questo file si incolla in un altro file in 11 celle contigue in orizzontale, poi si va giu di x (=38) righe e si incolla per altre 11 celle contigue e così via fino ad arrivare al 132 esimo incollaggio in modo da riprodurre una matrice di dati in riferimento alla matrice iniziale
•    Il risultato della macro su indicata si incolla anche in un altro foglio a seguire dalla riga 2 in giù ogni volta di y (=150) righe per 132 volte come storico dati.

Io ho registrato la macro che funziona correttamente per 132 volte ma è troppo grande e non riesco ad eseguirla, cerco il modo di renderla eseguibile.
Vi riporto tre cicli in modo da capire il funzionamento, mi servirebbe capire come rendere compatta ed eseguibile questa routine.

Grazie mille  :k: :)


Codice sorgente - presumibilmente Plain Text
  1. ........
  2. ........
  3.  
  4.     Range("O2").Select
  5.  
  6.     [b]ActiveCell.FormulaR1C1 = "110"
  7.     [/b]    
  8.     Range("P2").Select
  9.  
  10.     [b]ActiveCell.FormulaR1C1 = "110"
  11.     [/b]
  12.         Range("P3").Select
  13.     Application.Run "SL_Test_Dukascopy_.xlsm!Macro3"
  14.     Sheets("DB").Select
  15.     Range("B3:AE700025").Select
  16.     ActiveSheet.Range("$B$2:$AE$700025").AutoFilter Field:=1, Criteria1:="<>"
  17.     Selection.Copy
  18.     Workbooks.Open Filename:="C:\Users\utente\Desktop\Portafoglio Post news.xlsm"
  19.     Sheets("Portafoglio globale").Select
  20.     Range("A12").Select
  21.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  22.         :=False, Transpose:=False
  23.     Workbooks.Open Filename:="C:\Users\utente\Desktop\Ottimizzazione_.xlsm"
  24.     Sheets("Dati").Select
  25.  
  26.     [b]Range("A4500").Select
  27.     [/b]
  28.         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  29.         :=False, Transpose:=False
  30.     Windows("Portafoglio Post news.xlsm").Activate
  31.     Sheets("Sintesi ").Select
  32.     Range("D2:D36").Select
  33.     Application.CutCopyMode = False
  34.     Selection.Copy
  35.     Windows("Ottimizzazione_.xlsm").Activate
  36.     Sheets("DB Ottimizzazioni").Select
  37.  
  38.     [b]Range("L73").Select
  39.      [/b]
  40.         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  41.         :=False, Transpose:=False
  42.     Application.CutCopyMode = False
  43.     ActiveWorkbook.Save
  44.     ActiveWindow.Close
  45.     Sheets("Portafoglio globale").Select
  46.     Application.Run "'Portafoglio Post news.xlsm'!Macro1"
  47.     ActiveWorkbook.Save
  48.     ActiveWindow.Close
  49.     ActiveSheet.Range("$B$2:$AE$700025").AutoFilter Field:=1
  50.     Sheets("Test").Select
  51.     Application.Run "SL_Test_Dukascopy_.xlsm!Macro2"
  52.    
  53.    
  54.  
  55.     Range("O2").Select
  56.  
  57. [b]ActiveCell.FormulaR1C1 = "25"
  58. [/b]
  59.     Range("P2").Select
  60.  
  61. [b]ActiveCell.FormulaR1C1 = "120"
  62. [/b]    
  63.     Range("P3").Select
  64.     Application.Run "SL_Test_Dukascopy_.xlsm!Macro3"
  65.     Sheets("DB").Select
  66.     Range("B3:AE700025").Select
  67.     ActiveSheet.Range("$B$2:$AE$700025").AutoFilter Field:=1, Criteria1:="<>"
  68.     Selection.Copy
  69.     Workbooks.Open Filename:="C:\Users\utente\Desktop\Portafoglio Post news.xlsm"
  70.     Sheets("Portafoglio globale").Select
  71.     Range("A12").Select
  72.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  73.         :=False, Transpose:=False
  74.     Workbooks.Open Filename:="C:\Users\utente\Desktop\Ottimizzazione_.xlsm"
  75.     Sheets("Dati").Select
  76.  
  77. [b]Range("A4650").Select
  78. [/b]    
  79.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  80.         :=False, Transpose:=False
  81.     Windows("Portafoglio Post news.xlsm").Activate
  82.     Sheets("Sintesi ").Select
  83.     Range("D2:D36").Select
  84.     Application.CutCopyMode = False
  85.     Selection.Copy
  86.     Windows("Ottimizzazione_.xlsm").Activate
  87.     Sheets("DB Ottimizzazioni").Select
  88.  
  89. [b]Range("M73").Select
  90. [/b]
  91.         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  92.         :=False, Transpose:=False
  93.     Application.CutCopyMode = False
  94.     ActiveWorkbook.Save
  95.     ActiveWindow.Close
  96.     Sheets("Portafoglio globale").Select
  97.     Application.Run "'Portafoglio Post news.xlsm'!Macro1"
  98.     ActiveWorkbook.Save
  99.     ActiveWindow.Close
  100.     ActiveSheet.Range("$B$2:$AE$700025").AutoFilter Field:=1
  101.     Sheets("Test").Select
  102.     Application.Run "SL_Test_Dukascopy_.xlsm!Macro2"
  103.    
  104.    
  105.  
  106.     Range("O2").Select
  107.  
  108. [b]ActiveCell.FormulaR1C1 = "25"
  109. [/b]
  110.  
  111.     Range("P2").Select
  112.  
  113. [b]ActiveCell.FormulaR1C1 = "130"
  114. [/b]
  115.         Range("P3").Select
  116.     Application.Run "SL_Test_Dukascopy_.xlsm!Macro3"
  117.     Sheets("DB").Select
  118.     Range("B3:AE700025").Select
  119.     ActiveSheet.Range("$B$2:$AE$700025").AutoFilter Field:=1, Criteria1:="<>"
  120.     Selection.Copy
  121.     Workbooks.Open Filename:="C:\Users\utente\Desktop\Portafoglio Post news.xlsm"
  122.     Sheets("Portafoglio globale").Select
  123.     Range("A12").Select
  124.     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  125.         :=False, Transpose:=False
  126.     Workbooks.Open Filename:="C:\Users\utente\Desktop\Ottimizzazione_.xlsm"
  127.     Sheets("Dati").Select
  128.  
  129. [b]Range("A4800").Select
  130. [/b]
  131.         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  132.         :=False, Transpose:=False
  133.     Windows("Portafoglio Post news.xlsm").Activate
  134.     Sheets("Sintesi ").Select
  135.     Range("D2:D36").Select
  136.     Application.CutCopyMode = False
  137.     Selection.Copy
  138.     Windows("Ottimizzazione_.xlsm").Activate
  139.     Sheets("DB Ottimizzazioni").Select
  140.  
  141. [b]Range("N73").Select
  142. [/b]
  143.         Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
  144.         :=False, Transpose:=False
  145.     Application.CutCopyMode = False
  146.     ActiveWorkbook.Save
  147.     ActiveWindow.Close
  148.     Sheets("Portafoglio globale").Select
  149.     Application.Run "'Portafoglio Post news.xlsm'!Macro1"
  150.     ActiveWorkbook.Save
  151.     ActiveWindow.Close
  152.     ActiveSheet.Range("$B$2:$AE$700025").AutoFilter Field:=1
  153.     Sheets("Test").Select
  154.     Application.Run "SL_Test_Dukascopy_.xlsm!Macro2"
  155.  
  156.  
  157. ..........
  158. ..........


e cosi per un totale di 132 volte!! per ogni ciclo cambiano le righe in grassetto cioè i 2 numeri iniziali, secondo una matrice prestabilita, e la posizione delle celle del 1° e 2° incollaggio dati di output, anche qui secondo una posizione già prestabilita all'inizio.




PM Quote