Velocizzare codice

Hai un problema con Excel?

Nuova discussione

Velocizzare codice
di Dvd78 (utente non iscritto) data: 29/04/2014 12:31:45
Salve a tutti,
ho creato un foglio excel per inserire dei dati di prove svolte dal mio laboratorio. Il foglio comprende una userform per inserimento dati che permette all'utente di inserire facilmente le informazioni e automaticamente scrive nel foglio nella giusta posizione. Il tutto funziona bene l'unico problema è una estrema lentezza del processo. Credo che sia dovuto alla poca ottimizzazione del codice (sono un principiante di vba). Potete aiutarmi?

La userform è chiamata da un pulsante sul foglio. Inoltre è presente un ulteriore foglio di appoggio per eseguire dei cerca.verticale che creano gli elenchi visibili nei combobox della userform

Private Sub SaveLab_Click()
Dim iRow As Integer
Application.ScreenUpdating = False
iRow = 7
While Cells(iRow, 1).Value <> ""
iRow = iRow + 1
Wend
Worksheets("Foglio1").Range("A1") = ""
'Cells(iRow, 1) = Cells(iRow, 1).Offset(-1, 0) + 1
Cells(iRow, 1) = TextBox1
Cells(iRow, 2) = TextBox2
Cells(iRow, 3) = ComboBox1.Text
Cells(iRow, 4) = TextBox4
Cells(iRow, 5) = TextBox5
Cells(iRow, 6) = TextBox6
Cells(iRow, 7) = TextBox7
Cells(iRow, 8) = TextBox8
Cells(iRow, 9) = TextBox9
Cells(iRow, 10) = TextBox10
Cells(iRow, 11) = TextBox11
TextBox1.Enabled = False
TextBox2.Enabled = False
ComboBox1.Enabled = False
TextBox4.Enabled = False
TextBox5.Enabled = False
TextBox6.Enabled = False
TextBox7.Enabled = False
TextBox8.Enabled = False
TextBox9.Enabled = False
TextBox10.Enabled = False
TextBox11.Enabled = False



Cells(iRow, 12) = TextBox15
Cells(iRow, 13) = TextBox13
Cells(iRow, 14) = TextBox14
Cells(iRow, 21) = TextBox16

If CheckBox1.Value = True Then
Cells(iRow, 15) = "X"
End If
If CheckBox3.Value = True Then
Cells(iRow, 16) = "X"
End If
If CheckBox4.Value = True Then
Cells(iRow, 17) = "X"
End If
If CheckBox5.Value = True Then
Cells(iRow, 18) = "X"
End If
If CheckBox2.Value = True Then
Cells(iRow, 19) = "X"
End If
If CheckBox6.Value = True Then
Cells(iRow, 20) = "X"
TextBox12.Enabled = False
End If


TextBox12 = ""
TextBox13 = ""
TextBox14 = ""
TextBox15 = ""
TextBox16 = ""

For N = 1 To 6  'si deselezionano tutte le checkbox
UserForm1.Controls("CheckBox" & N).Value = False
Next



End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Frame2.Visible = True
End Sub

Private Sub CommandButton2_Click()
Worksheets("Foglio1").Range("A1") = TextBox1
End Sub

di Grograman (utente non iscritto) data: 29/04/2014 12:52:13
Ahia ahia ahia non c'è cosa più rognosa che ricostruire una userform da zero....

No file no party!

Intanto una sfoltita e indentata sommaria al codice (a cui manca la dichiarazione delle variabili!!!)

Option Explicit

Private Sub SaveLab_Click()
Dim iRow As Long 'integer non è sufficiente
  Application.ScreenUpdating = False
  iRow = Range("A" & Rows.Count).End(xlUp).Row + 1 'immagino il ciclo while serva a trovare l'utima cella piena
'  While Cells(iRow, 1).Value <> ""
'    iRow = iRow + 1
'  Wend
  Worksheets("Foglio1").Range("A1") = ""
  'Cells(iRow, 1) = Cells(iRow, 1).Offset(-1, 0) + 1
  For i = 1 To 11
    If i <> 3 Then
      Cells(iRow, i) = userform1.Controls("TextBox" & i)
      userform1.Controls("TextBox" & i).Enabled = False
    Next i
  Next i

  Cells(iRow, 3) = ComboBox1.Text
  ComboBox1.Enabled = False

  
  Cells(iRow, 12) = TextBox15
  Cells(iRow, 13) = TextBox13
  Cells(iRow, 14) = TextBox14
  Cells(iRow, 21) = TextBox16
  
  If CheckBox1.Value = True Then
    Cells(iRow, 15) = "X"
  End If
  If CheckBox2.Value = True Then
    Cells(iRow, 19) = "X"
  End If
  If CheckBox3.Value = True Then
    Cells(iRow, 16) = "X"
  End If
  If CheckBox4.Value = True Then
    Cells(iRow, 17) = "X"
  End If
  If CheckBox5.Value = True Then
    Cells(iRow, 18) = "X"
  End If
  If CheckBox6.Value = True Then
    Cells(iRow, 20) = "X"
    TextBox12.Enabled = False
  End If
  
  
  TextBox12 = ""
  TextBox13 = ""
  TextBox14 = ""
  TextBox15 = ""
  TextBox16 = ""
  
  For N = 1 To 6  'si deselezionano tutte le checkbox
    userform1.Controls("CheckBox" & N).Value = False
  Next
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
  Frame2.Visible = True
End Sub

Private Sub CommandButton2_Click()
  Worksheets("Foglio1").Range("A1") = TextBox1
End Sub

di Dvd78 (utente non iscritto) data: 29/04/2014 14:10:42
Ciao grazie dell'interesse, hai ragione senza file non si capisce un tubo!!!

Ho allegato un file di esempio spernado di rendere più chiaro il mio problema. Aumentando le righie inserite e creando eventualmente una seconda userform per altri tipi di inserimenti il sistema ci impiega una vita a svolgere normali operazioni di scrittura.

Aspetto fiducioso un vostro aiuto

di Grograman (utente non iscritto) data: 29/04/2014 14:47:48
Come dicevo prima da una prova spannometrica è proprio quel ciclo while che ti rallenta.

E devi inoltre dichiarare tutte le variabili e usare una long per iRow!!

Sostituisci:
iRow = 7
While Cells(iRow, 1).Value <> ""
iRow = iRow + 1
Wend

Con
iRow = Range("A" & Rows.Count).End(xlUp).Row + 1



Che diventa:
Option Explicit
Private Sub SaveLab_Click()
Dim iRow As Long, i As Long, n As Long
  Application.ScreenUpdating = False
  iRow = Range("A" & Rows.Count).End(xlUp).Row + 1
  Worksheets("Foglio1").Range("A1") = ""
  For i = 1 To 11
    If i <> 3 Then
      Cells(iRow, i) = UserForm1.Controls("TextBox" & i)
      UserForm1.Controls("TextBox" & i).Enabled = False
    End If
  Next i
  Cells(iRow, 3) = ComboBox1.Text
  ComboBox1.Enabled = False
  Cells(iRow, 12) = TextBox15
  Cells(iRow, 13) = TextBox13
  Cells(iRow, 14) = TextBox14
  Cells(iRow, 21) = TextBox16
  
  If CheckBox1.Value = True Then
    Cells(iRow, 15) = "X"
  End If
  If CheckBox2.Value = True Then
    Cells(iRow, 19) = "X"
  End If
  If CheckBox3.Value = True Then
    Cells(iRow, 16) = "X"
  End If
  If CheckBox4.Value = True Then
    Cells(iRow, 17) = "X"
  End If
  If CheckBox5.Value = True Then
    Cells(iRow, 18) = "X"
  End If
  If CheckBox6.Value = True Then
    Cells(iRow, 20) = "X"
    TextBox12.Enabled = False
  End If
  
  
  TextBox12 = ""
  TextBox13 = ""
  TextBox14 = ""
  TextBox15 = ""
  TextBox16 = ""
  
  For n = 1 To 6  'si deselezionano tutte le checkbox
    UserForm1.Controls("CheckBox" & n).Value = False
  Next n
End Sub

di Grograman (utente non iscritto) data: 29/04/2014 14:58:32
Stavo pensando che sul file allegato anche il codic e"lento", con più di 70.000 righe, ci mette pochi decimi di secondo.

Forse i rallentamenti di cui parlano dipendono dal ricalcolo delle formule.
Potresti momentaneamente impostarlo a manuale, eseguire il codice, e riportarlo automatico:

Sub StoCalcolo()
Dim xlCalc As XlCalculation
With Application
  xlCalc = .Calculation 'controllo come calcola prima di modificare le impostazioni
  .Calculation = xlCalculationManual 'imposto a manuale
End With
'''''''''''''''''''''''
'''qui il tuo codice'''
'''qui il tuo codice'''
'''qui il tuo codice'''
'''''''''''''''''''''''
With Application
  .Calculation = xlCalc 'riporto come prima
  .Calculate
End With
End Sub

di dvd78 (utente non iscritto) data: 29/04/2014 15:08:10
Ciao grazie, effettivamente senza il ciclo si nota un miglioramento e probabilmente e proprio il ricalcolo che mi ritarda il tutto.

Altra piccola domanda, vorrei inserire una seconda userform oer completare alcuni campi della riga inseriti da un secondo utente. Con una prima combobox creo un elenco univoco della chiave CTA ref (riesco e vorrei in una seconda combobox mi apparisse solo l'elenco di un altro campo di dati corrispondenti. Ovviamente c'è una relazione 1 a molto tra cta ref e altro campo (nr. lab)

Come faccio?
di dvd78 (utente non iscritto) data: 29/04/2014 15:11:34
Altra piccola cosa,
mi pieghi la dichiarazione delle variabili?? non lo già fatto all'interno della SUB???

di Grograman (utente non iscritto) data: 29/04/2014 15:16:57
Se ho capito bene, potresti mettere una combobox con i valori univoci del campo CTA Ref, e una listbox che alimenti al variare della cbo.

(ovviamente puoi usare una textbox sela cbo non ti soddisfa!)

Private Sub ComboBox1_Change()
Dim i As Long, iRow As Long
iRow = Worksheets("Lista Attività").Range("A" & Rows.Count).End(xlUp).Row
For i = 7 To iRow
  If Cells(i, 1) = Me.ComboBox1.Value Then
    Me.ListBox1.AddItem Cells(i, 4) 'esempio a caso, inserico nella listbox il campo "customer" a parità di "Cta Ref"
  End If
Next i
End Sub

di Grograman (utente non iscritto) data: 29/04/2014 15:20:18
cit: "Altra piccola cosa, mi pieghi la dichiarazione delle variabili?? non lo già fatto all'interno della SUB??? "

Tu scrivi semplicemente "Option explicit" all'inizio di un modulo (o vai nell'editor da "strumenti" "opzioni" e spunta la relativa opzione.

Poi lancia i codici che usi normalmente e vedi che succede
di dvd78 (utente non iscritto) data: 29/04/2014 15:22:41
Graize!!!
come spesso accade le soluzioni più semplici sono le migliori, peccato che non sempre riesco a vederle.
Scusami se abuso della tua pazienza ma mi spieghi il discorso della dichiarazione pubblica delle variabili?
di Grograman (utente non iscritto) data: 29/04/2014 16:47:54
Uhm... ma parli della dichiarazione obbligatoria, o di variabili pubbliche?

Se parli di quelle pubbliche ti rimando alla guida microsoft così ci mette dentro anche le statiche ^_^

h t t p: // support . microsoft . com/ k b / 1 4 1 6 9 3 / it

Senza spazi ovviamente!
Ovvero copiatelo in Excel come

(si lo so, sono un pirla...)
=ANNULLA.SPAZI("h t t p: // support . microsoft . com/ k b / 1 4 1 6 9 3 / it")

Vuoi Approfondire?