altre strade

Hai un problema con Excel?

Nuova discussione

altre strade...
di Textomb data: 08/08/2013 23:19:12
allego un file su cui ho riportato l'esempio che di seguito spiego in sintesi.
Ho una tabella con diverse centinaia di righe e cinque colonne.
Nella prima colonna ho il codice della matrice, in un'altra colonna ho i kg_lavorati e, in un'altra la resa media (kg/h).
l'obiettivo è quella di popolare una tabella di summit, posta accanto, che, assegna ad ogni range di resa media, il quantitativo di kg lavorati ed il numero di matrici corrispondenti. Forse a spiegarlo non sembra facile. Ma invece lo è.
Io ho scritto questo codice per risolvere la questione. E, in effetti, funziona.
L'unico problema è che ci mette, con la mia macchina, 4 sec. per completare l'elaborazione.
Allora, volevo stuzzicare gli utenti del Forum ad avanzare altre ipotesi più performanti, che magari potessero risolvere la cosa meglio ed in meno tempo.
Ovviamente rimuovere l'aggiornamento dello schermo non vale. Troppo semplice.

Option Explicit

Sub BuiltSummit()
Dim Lr As Integer, cell As Range, V As Range, M As Range, RisM As Range, LimInf As Integer, LimSup As Integer, Start As Single
Lr = Cells(Rows.Count, 1).End(xlUp).Row - 1 'Escludo l'ultima riga con i totali
Set M = Range("a4:a" & Lr) 'colonna dei codici delle Matrici
Set RisM = Range("i5:i26") 'colonna dei risultati aggregati


Start = Timer

[k5:l26].ClearContents
Dim Resa As Integer, kgEstr As Long

For Each cell In M
kgEstr = cell.Offset(, 1)
Resa = cell.Offset(, 3)

    For Each V In RisM
    LimInf = V
    LimSup = V.Offset(, 1)
        If Resa >= LimInf And Resa <= LimSup Then
        V.Offset(, 2) = V.Offset(, 2) + 1
        V.Offset(, 3) = V.Offset(, 3) + kgEstr
        Exit For
        End If
    Next V

Next cell

MsgBox "Finito in sec: " & Round((Timer - Start), 1), vbInformation

End Sub

di isy data: 09/08/2013 00:33:04
Ciao
Cit: L'unico problema è che ci mette, con la mia macchina, 4 sec. per completare l'elaborazione.

Ho modificato il codice, spero sia più rapido

Sub Speed()
  Dim Lr As Long, start, cell As Long
  start = timer
  Lr = Cells(Rows.Count, 1).End(xlUp).Row - 1 'Escludo l'ultima riga con i totali
  Dim M As Variant, RisM As Variant, v As Long
  M = Range("A4:E" & Lr) 'colonna dei codici delle Matrici
  RisM = Range("I5:J26") 'colonna dei risultati aggregati
  [k5:l26].ClearContents
  Dim Resa As Integer, kgEstr As Long
  Dim LimInf As Long, LimSup As Long
  Dim K()
  ReDim K(1 To 22, 1 To 2)
  For cell = 1 To UBound(M)
    kgEstr = M(cell, 2)
    Resa = M(cell, 4)

    For v = 1 To UBound(RisM)
    LimInf = RisM(v, 1)
    LimSup = RisM(v, 2)
      If Resa >= LimInf And Resa <= LimSup Then
        K(v, 1) = K(v, 1) + 1           'Ex Cells(v + 4, "K") = Cells(v + 4, "K") + 1
        K(v, 2) = K(v, 2) + kgEstr      'Ex Cells(v + 4, "L") = Cells(v + 4, "L") + kgEstr
        Exit For
        End If
    Next v

  Next cell
  Range("K5:L5").Resize(UBound(K, 1)) = K
  
  MsgBox "Finito in sec: " & Round((timer - start), 1), vbInformation
End Sub

di HarryBosch data: 09/08/2013 01:26:54
Ok, niente trucchetto del ScreenUpdating...
Ecco qua..

Sub BuiltSummit_HB()
  Dim rng As Range, r As Byte, start As Single
  Application.Calculation = xlCalculationManual
  start = Timer

  [k5:l26].ClearContents
  [a3].AutoFilter

  Set rng = [a3].CurrentRegion

  For r = 6 To 26
    rng.AutoFilter 4, ">=" & Str(Cells(r, "i") - 0.5), xlAnd, "<=" & Str(Cells(r, "j") + 0.5)
    Cells(r, "k") = WorksheetFunction.Subtotal(3, rng.Columns(1)) - 1
    Cells(r, "l") = WorksheetFunction.Subtotal(9, rng.Columns(2))
  Next

  [a3].AutoFilter

  MsgBox "Finito in sec: " & Round((Timer - start), 1), vbInformation
  Application.Calculation = xlCalculationAutomatic
End Sub

di HarryBosch data: 09/08/2013 01:32:38
@ isy
cit: "Ho modificato il codice, spero sia più rapido"
era un eufemismo! Neanche il tempo di avviarla ^_^
di Grograman data: 09/08/2013 10:15:45
Mi sfugge perchè scomodare VBA, ancorchè suo grande sostenitore ^_^

Occhio agli arrotondamenti, codice KK01108: resa kg/h = 1.700,7229
Per la mia formula 1.700,7229 >= 1701 = falso
da K5 in giù =CONTA.PIÙ.SE(D:D;">="&I5;D:D;"<="&J5) da L5 in giù =SOMMA.PIÙ.SE(B:B;D:D;">="&I5;D:D;"<="&J5)
di Textomb data: 09/08/2013 11:03:18
@isy
cit. Ho modificato il codice, spero sia più rapido
sinceramente non sono stato in grado di misurare il tempo. Cioè non mi dava il tempo di avviare la routine che già aveva finito.
Forte l'idea di scrivere i risultati in una matrice di appoggio e poi spararli tutti in una volta sul range di destinazione.
Range("K5:L5").Resize(UBound(K, 1)) = K
Complimenti davvero.

@HB
fastidioso lo sfibrillamento dello schermo. Ma niente trucchetto... Quindi giusto così.
I filtri sono una gran comodità. Prendi tutti i valori che servono in una volta... e poi passi al prossimo range.
Come sempre HB, grande eleganza. Imparo sempre da te.

@Grograman
cit. Mi sfugge perchè scomodare VBA, ancorchè suo grande sostenitore ^_^
La ragione in effetti è nascosta.
La tabella dei valori riferiti alle matrici è aggiornata in tempo reale perchè collegata con un PLC con cui scambia i dati provenienti da un processo produttivo.
La formula da te suggerita, sebbene perfettamente funzionante, non posso adoperarla perchè i valori di Summit non devono essere aggiornati in tempo reale ma solo all'occorrenza. Ecco perchè mi servono valori statici ed elaborati sul momento.
In ogni caso, ho memorizzato il tuo valido contributo sulla mia macchina.

Alla fine però siete stati tutti promossi..
Qui, l'unico rinviato a settembre sono io..
di Grograman (utente non iscritto) data: 09/08/2013 11:28:40
Bhè potresti mettere il calcolo manuale del foglio, poi quando ti serve premere F9 ;)

Comunque sia la soluzione di Isy sembra davvero la più veloce :)

di isy data: 09/08/2013 12:26:45
Ciao

Cit: Grograman
Mi sfugge perchè scomodare VBA, ancorchè suo grande sostenitore ^_^
Occhio agli arrotondamenti, codice KK01108: resa kg/h = 1.700,7229
Per la mia formula 1.700,7229 >= 1701 = falso

Utilizzando le formule proposte In vba puoi anche scrivere:
Ho commentato i passaggi nel codice

Un'alternativa con le formule.

Sub Speed_Formula()
'--- Con un unico passaggio inserisco tutte le formule e riporto i valori nel range
  With Range("K5:K26")
'--- Inserisci la formula colonna K sul foglio
    .Formula = "=COUNTIFS(C[-7],"">=""&RC[-2],C[-7],""<=""&RC[-1])"
'--- Converti la formula in valore
    .Value = .Value
'--- Inserisci la formula colonna L sul foglio
    .Offset(, 1).Formula = "=SUMIFS(C[-10],C[-8],"">=""&RC[-3],C[-8],""<=""&RC[-2])"
'--- Converti la formula in valore
    .Offset(, 1).Value = .Offset(, 1).Value
  End With
End Sub

Vuoi Approfondire?