Ciclo vs formule

Hai un problema con Excel?

Nuova discussione

Ciclo vs formule
di Porkaloca (utente non iscritto) data: 27/11/2017 19:35:20
Ciao a tutti..
io ho scritto un ciclo che verifica delle condizioni e esegue cambiamenti..
Ora.. Lo stesso risultato lo posso ottenere con delle formule (sempre attraverso macro).. il mio dubbio riguarda il tempo di esecuzione..
il ciclo ci mette sempre 100-120 secondi per completarsi, mentre con le formule otterrei tutto molto più velocemente.. e secondo me sto sbagliando qualcosa..

Quello che voglio ottenere penso sia comprensibile.. Qualcuno mi potrebbe spiegare dove sbaglio?

For i = 7 To 2705


If Sheets("Impianto Base").Cells(i, "B").Value = 1 And Sheets("Impianto Base").Range("M" & i) <> "NON IN GIACENZA" And Sheets("Impianto Base").Range("N" & i) = 1 And Sheets("Parametri").Range("A" & i) <> 0 Then
Sheets("Impianto Base").Range("F" & i & ":H" & i).ClearContents
Sheets("Impianto Base").Range("O" & i & ":P" & i).Copy
Sheets("Impianto Base").Range("F" & i).PasteSpecial xlPasteValues
Sheets("Impianto Base").Range("H" & i) = 1

End If


Next

di Zer0Kelvin data: 27/11/2017 23:31:22
Ciao.
Anche se non sembra esserci nulla che giustifichi quei tempi, quando una macro scrive in molte celle è sempre meglio disabilitare eventi, ricalcolo e screenupdating.
Anche non dichiarare il tipo delle variabili usate può rallentare l'esecuzione.

Sub Ciclo()
Dim I As Long
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    With Sheets("Impianto Base")
        For I = 7 To 2705
            If .Cells(I, "B").Value = 1 And .Range("M" & I) <> "NON IN GIACENZA" And .Range("N" & I) = 1 And _
                            Sheets("Parametri").Range("A" & I) <> 0 Then
                '.Range("F" & I & ":H" & I).ClearContents '<<==Superflua, il range viene sovrascritto
                .Range("O" & I & ":P" & I).Copy
                .Range("F" & I).PasteSpecial xlPasteValues
                .Range("H" & I) = 1
            End If
        Next I
    End With
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

di Porkaloca (utente non iscritto) data: 28/11/2017 21:38:12
Ciao. Intanto grazie, sia della soluzione sia della spiegazione..

Come quello del cancellare sono sicuro che ci sono un sacco di operazioni superflue o sbagliate..
Ti lascerei la macro completa.. Qualunque informazione riesci a darmi è molto apprezzata..

Per esempio: la formattazione "con rientro" nella tua macro è per capire meglio in che passaggio sei o ha anche altre motivi?

posizionando il blocco:

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True

prima dell'end sub le formule non si aggiornano.. come mai? cioè, non c'è un exit sub.. ci dovrebbe "passare" per quel blocco..

Sulla macro:
- L'estrai stringa mi serve per capire se l'informazione comincia con lo "0".. l'excel generato dal gestionale(che uso come confronto giacenze), ovviamente li cancella,mentre per me sono caratteri significativi..
- Le formule le "mando" in un'altro foglio so che non è utile, ma l'ho capito dopo aver scritto la macro..
- Visto che non ne sò niente, la macro è un misto di registratore e quello che ho capito su VBA..
- La colonna B funziona da falsa colonna di checkbox.. avevo trovato il modo per usare le cbox ma il file diventava di una lentezza infinita..
questa la macro del foglio:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Sheets("Parametri").Range("C2").Value = FALSO Then
Sheets("Impianto Base").Range("B7:T2705").Interior.Pattern = xlNone
If ActiveCell.Row > 6 And ActiveCell.Row < 2705 Then
Range("b" & ActiveCell.Row & ":Q" & ActiveCell.Row).Interior.ColorIndex = 35
End If
End If

CheckArea = "B7:B2700"
On Error Resume Next
If Not Application.Intersect(ActiveCell, Range(CheckArea)) Is Nothing Then
Application.EnableEvents = False
If Selection.Value = 1 Then
Range("B" & ActiveCell.Row).ClearContents
Else: Selection.Value = 1
End If
ActiveCell.Offset(0, 0).Select
End If

Application.EnableEvents = True
End Sub

TUtto quello che riesci a spiegare, spiega!:)

grazie di nuovo!!

Sub Correggi_errori()

    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    
Dim aW As Range
Dim bW As Range
Dim cW As Range
Dim dW As Range
Dim eW As Range
Dim bbW As Range
Dim aaW As Range
Dim i As Long
Dim erre As Integer

Set aW = Sheets("Parametri").Range("A7:A2705")
Set bW = Sheets("Parametri").Range("B7:B2705")
Set cW = Sheets("Parametri").Range("C7:C2705")
Set dW = Sheets("Parametri").Range("D7:D2705")
Set eW = Sheets("Parametri").Range("E7:E2705")
Set bbW = Sheets("Impianto Base").Range("B7:B2705")
Set aaW = Sheets("Parametri").Range("C3")
erre = 0

aW.FormulaR1C1 = "=MID(Imp_Base[@LOTTO],1,1)"

On Error Resume Next

Sheets("Impianto Base").Activate

For i = 7 To 2705

If Sheets("Impianto Base").Cells(i, "B").Value = 1 And Sheets("Impianto Base").Range("M" & i) = "NON IN GIACENZA" Then
Sheets("Impianto Base").Range("F" & i & ":H" & i).ClearContents

End If


If Sheets("Impianto Base").Cells(i, "B").Value = 1 And Sheets("Impianto Base").Range("M" & i) <> "NON IN GIACENZA" And Sheets("Impianto Base").Range("N" & i) = 1 And Sheets("Parametri").Range("A" & i) <> 0 Then
Sheets("Impianto Base").Range("F" & i & ":H" & i).ClearContents
Sheets("Impianto Base").Range("O" & i & ":P" & i).Copy
Sheets("Impianto Base").Range("F" & i).PasteSpecial xlPasteValues
Sheets("Impianto Base").Range("H" & i) = 1

End If


If Sheets("Impianto Base").Cells(i, "B").Value = 1 And Sheets("Impianto Base").Range("M" & i) <> "OK" And Sheets("Impianto Base").Range("M" & i) <> "NON IN GIACENZA" And Sheets("Parametri").Range("A" & i) = 0 Then
erre = erre + 1


End If

If Sheets("Impianto Base").Cells(i, "B").Value = 1 And Sheets("Impianto Base").Range("M" & i) <> "OK" And Sheets("Impianto Base").Range("M" & i) <> "NON IN GIACENZA" And Sheets("Impianto Base").Range("N" & i) > 1 Then

erre = erre + 1


End If


Next

aW.ClearContents
Sheets("Impianto Base").Activate

Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True


If erre + erre > 0 Then

If MsgBox("Ci sono  " & erre & "  referenze con errori che non è stato possibile correggere  e altre  " & Sheets("Parametri").Range("I2").Value - erre & "  righe con errori che non erano selezionate.  Vuoi selezionarle tutte ?", vbYesNo, "Operazione Completata") = vbYes Then

Application.ScreenUpdating = False

bbW.ClearContents

Sheets("Parametri").Activate
aW.FormulaR1C1 = _
        "=IF(Imp_Base[@INVENTARIO]=""OK"",""0"",""1"")"
       bW.FormulaR1C1 = _
        "=IF(Imp_Base[@INVENTARIO]=""IN SCADENZA"",""0"",""1"")"
cW.FormulaR1C1 = "=RC[-2]+RC[-1]+RC[+1]"
dW.FormulaR1C1 = _
"=IF(AND(Imp_Base[@INVENTARIO]=""NON IN GIACENZA"",Imp_Base[@QTA]<0.5),-1,0)"
eW.FormulaR1C1 = _
        "=IF(RC[-2]<2,"""",1)"
        eW.Copy
        bbW.PasteSpecial xlPasteValues
        
        Range(aW, eW).ClearContents
        Application.CutCopyMode = False
 Sheets("Impianto Base").Activate
 Range("N2").Select
 



   dimmi = MsgBox("Ok, ho selezionato le referenze con errori.", vbInformation, "Operazione Completata")
End If

Exit Sub



Else
dimmi = MsgBox("Tutte le righe selezionate sono state corrette.", vbInformation, "Operazione Completata")
End If

Application.ScreenUpdating = True

    
End Sub

di Porkaloca (utente non iscritto) data: 28/11/2017 21:43:14
Un'altra cosa.. C'è un modo di usare come range un campo di una tabella?? mi sembra impossibile che non ci sia..anche excel lo usa
di patel data: 29/11/2017 08:05:27
se alleghi un file di esempio da testare è molto meglio
di Porkaloca (utente non iscritto) data: 29/11/2017 17:56:25
allegato, ma ho dovuto castrarlo parecchio perchè era troppo pesante

Vuoi Approfondire?