MACRO O FORMULA

[Lucio Peruggini]

Buona serata
Gentilmente approfitterei della vostra pazienza e disponibilità per una formula o macro che faccia quanto segue.

Allego immagine ma anche il file sul quale poter intervenire.

In B1: I1 ho impostato per ogni cella valori (fasce o step) che possono variare secondo il caso e comunque, sempre di diciotto in diciotto.
Nella fattispecie ho impostato 1- 40; 41- 80; 81-120; 121-160; 161-200; 201-240;
241-280; 281-320; ma possono diventare anche:
1–18; 19 –36; 37–45; 46–54; 55–72; 73–90; e così per le altre.
Sono nove fasce dalle quali prelevare in colonna E6:E50000 i valori contrassegnati alla riga 4 da B4 : I4.

Ora questi valori li sto ricavando con i filtri ma vorrei automatizzare il processo con macro o formula, perché dovendo spesso cambiare i dati in riga 1, il procedimento manuale (filtri) è troppo lungo.

Esempio:

Filtro:
Minori o uguali 40 ………………………….. 742 casi rimasti in questa fascia.
Maggiori di 40 e minori di 81…………..249 casi rimasti in questa fascia.
Maggiori di 80 e minori di 121………….90 casi rimasti in questa fascia.
Così per tutte le altre fasce.

Ringrazio come sempre per l’aiuto recatomi.

Ciao

https://dl.dropbox.com/u/18220462/FILE/ ... %20NZ.xlsx

[Lucio Peruggini]

scusate ho sbagliato una dicitura:

Ho scritto "sempre di diciotto in diciotto" E' errato!
Sarà diciotto per fasce o step che iniziano con uno diciotto; se esse iniziano con step 1-40, i restanti avranno step 40.
ciao

[Lucio Peruggini]

Scusatemi ancora, ho aggiunto una fascia che va da 321 a 360 colonna "J".
Abbiate pazienza, grazie.

[Flash30005]

Prova questa macro

Codice: Seleziona tutto

Sub CompilaEv()
Set Ws1 = Worksheets("AMBO TT DA NZ")
URE = Ws1.Range("E" & Rows.Count).End(xlUp).Row
For CC1 = 2 To 10
    RangeC = Ws1.Cells(1, CC1).Value
    Num1 = Val(Mid(RangeC, 1, InStr(RangeC, "-") - 1))
    Num2 = Val(Mid(RangeC, InStr(RangeC, "-") + 1, Len(RangeC) - InStr(RangeC, "-")))
    ContaE = 0
    For RRE = 6 To URE
        If Ws1.Range("E" & RRE).Value >= Num1 And Ws1.Range("E" & RRE).Value <= Num2 Then ContaE = ContaE + 1
    Next RRE
    Ws1.Cells(4, CC1).Value = ContaE
Next CC1
End Sub


Ciao

[Anthony47]

Invece con formula:
Prima una piccola variazione al layout dei tuoi dati:
Lasci vuota M1, poi in N1

Codice: Seleziona tutto

=M1+40

e copi verso destra

In B1 metti la formula

Codice: Seleziona tutto

=(M1+1)&"-"&N1

e copi verso destra per ricreare una intestazione

In B4

Codice: Seleziona tutto

=CONTA.SE($E6:$E50000;"<="&N1)

In C4

Codice: Seleziona tutto

=CONTA.SE($E6:$E50000;"<="&O1)-SOMMA($B$4:B4)

e copi verso destra

Ciao a tutti.

[Lucio Peruggini]

Grazie molte amici miei.
Proverò le soluzioni ma sono certo che entrambe funzioneranno benissimo!
Vi farò sapere.
Ciao

[Lucio Peruggini]

Come supponevo le due soluzioni sono ottime entrambe.

Per Anthony: Ho provato a cambiare il passo o step in N1, da 40 a 18 ma viene fuori un papocchio.
Devo poter cambiare questo step secondo i dati inseriti nel foglio di lavoro.

Per Flash: ho cambiato lo step inserendo da 1 a 18 e multipli; funziona perfettamente!

Più che bravi!!! Grazie per il grande aiuto che trovo in questo forum.

Ciao

Mi edito

Chiedo: E possibile poter inserire uno step a piacere e quindi diverso dai multipli?

[Flash30005]

E possibile poter inserire uno step a piacere e quindi diverso dai multipli?

alla macro non importa quali numeri inserirai (se step di multipli o no)
purché sia un range crescente e avente il simbolo "-" (meno senza virgolette), come separatore tra i due numeri del range
1-20, 15-40, 30-70 etc
Puoi anche lasciare uno spazio
1 - 20, 15 - 40, 30 - 70 etc

ciao

EDIT ore 5:00 - Puoi anche ottenere il risultato con una formula da inserire in B4, senza modificare lo schema dati e rispettando quanto detto per la macro

Codice: Seleziona tutto

=CONTA.SE($E6:$E50000;">="&VALORE(STRINGA.ESTRAI(B1;1;TROVA("-";B1)-1)))-CONTA.SE($E6:$E50000;">"&VALORE(STRINGA.ESTRAI(B1;TROVA("-";B1)+1;LUNGHEZZA(B1))))

Trascina verso destra fino a J

[Anthony47]

Se devi cambiare lo stepping in modo dinamico, allora in N1 invece di mettere =M1+40 metterai =M1+$N$2 e copierai poi verso dx; in N2 inserirai il passo voluto che si riflettera' anche sulle intestazioni della tua tabella.

Guarda i messaggi di Flash sopra.

Ciao a tutti.

[Lucio Peruggini]

Ciao Anthony, ciao Flash

SEMPLICEMENTE IMPECCABILE!!!!

Ho allungato fino a "L" lo step, funzionano che è una meraviglia sia la macro che le formule.
In questo caso penso che le formule siano più veloci e quindi adopererò queste.

Infinita gratitudine!!!

[Lucio Peruggini]

Se devi cambiare lo stepping in modo dinamico, allora in N1 invece di mettere =M1+40 metterai =M1+$N$2 e copierai poi verso dx; in N2 inserirai il passo voluto che si riflettera' anche sulle intestazioni della tua tabella.

Guarda i messaggi di Flash sopra.

Ciao a tutti.

Ciao Anthony, scusa il ritardo ma solo ora ho potuto controllare bene anche la tua formula. C'è qualcosa che non va oppure sbaglio io? Allego immagine laddove noterai nella barra sopra, la formula inserita in "N1" e in N2 il passo inserito
1-18.
Ciao

https://dl.dropbox.com/u/18220462/IMMAG ... 0forum.PNG

[Anthony47]

Nella mia interpretazione in N2 scriverai 18, oppure 40, oppure 6 (non un intervallo tipo 1-18).

Ciao

[Lucio Peruggini]

TROPPO FORTE!!!
Ma come ti vengono.....................?

Grazie Anthony e buona giornata.

[Lucio Peruggini]

ALTRO grandissimo aiuto forse un po’ complesso non per difficoltà (almeno per voi), quanto per il tempo che richiede.

Come da file e immagine allegati devo ricavare quanto segue:

Range B2:F19 (formula o macro). Penso che le formule in questo caso appesantirebbero troppo il file.

1) “B2:F19” Trova tutti i numeri univoci e li segna alla fine di ogni ciclo composto di 18 estrazioni da CZ19 e verso destra, in ordine crescente.
2) A questo punto, nel range successivo “J20:CU20” la macro deve, un’estrazione per volta e per il ciclo completo (18), inserire nella riga di appartenenza J20:CU20; J21:CU21 etc. i numeri univoci trovati nel ciclo precedente e marcati da CZ19 in poi. Dunque, gli univoci del precedente ciclo se sono usciti in B20:F20 vanno marcati nella colonna specifica del numero corrispondente da J1 a CU1.
3) In CZ 18 , sopra la riga ”univoca”, sarà marcato quante volte il numero univoco è uscito nel ciclo successivo esaminato.
Esempio:

Riga 20 sono usciti i numeri 7-29-56-63 e sono stati segnati ognuno sotto il proprio corrispondente in colonna “J:CU”
Riga 21 sono usciti i numeri 16-48-88
Riga 22 è uscito il 40
Riga 23 sono usciti i numeri 4-8-72
Riga 24 sono usciti i numeri 3-31-35-73

Così per le righe successive fino alla trentasette, laddove finisce un ciclo è inizia l’altro.
Si prendono dunque, i numeri univoci di un ciclo e in quello successivo si marcano le uscite inserendole da “J a CU”.

Spero di non aver fatto confusione nella spiegazione.
Grazie infinite!!!

https://dl.dropbox.com/u/18220462/FILE/ ... 0CICLO.PNG

https://dl.dropbox.com/u/18220462/FILE/ ... it.%29.zip

[Flash30005]

Sei sicuro di avere l'archivio distribuito così (un foglio per ogni ruota)?

Se così come fai ad aggiornare l'archivio?
Non vorrei che, alla fine, hai l'archivio con tutte le ruote inserite e bisogna rimettere le mani alle macro

ciao

[Flash30005]

Leggi quanto ho scritto qui sopra ma....
ormai è tardi...

Codice: Seleziona tutto

Sub ContaUnici()
Start = Timer
Application.ScreenUpdating = False
Application.Calculation = xlManual
For FF = 1 To Worksheets.Count
If Len(Sheets(FF).Name) > 2 Then GoTo SaltaFF
Sheets(FF).Select
UR1 = Range("A" & Rows.Count).End(xlUp).Row
Range("CZ18:GK" & UR1).ClearContents
For RR1 = 2 To UR1 - 18 Step 18
    For NR = 1 To 90
        MyPre = Evaluate("=SUM(COUNTIF(B" & RR1 & ":F" & RR1 + 17 & "," & NR & "))")
        If MyPre = 1 Then
            UC1 = Cells(RR1 + 17, Columns.Count).End(xlToLeft).Column + 1
            If UC1 < 104 Then UC1 = 104
            Cells(RR1 + 17, UC1).Value = NR
        End If
    Next NR
Next RR1
UR2 = Range("CZ" & Rows.Count).End(xlUp).Row
For RR2 = 19 To UR2 Step 18
    UC2 = Cells(RR2, Columns.Count).End(xlToLeft).Column
    For CC2 = 104 To UC2
        NR = Cells(RR2, CC2).Value
        MyPre = Evaluate("=SUM(COUNTIF(B" & RR2 + 1 & ":F" & RR2 + 18 & "," & NR & "))")
        Cells(RR2 - 1, CC2).Value = MyPre
    Next CC2
Next RR2
SaltaFF:
Next FF
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Fine = Timer - Start
MsgBox "Elaborato in " & Int(Fine) & " sec"
End Sub

Questa macro fa il conteggio che volevi da CZ in poi e impiega 13 secondi, con il mio Pc, per elaborare tutte le ruote
Non ho volutamnete inserire i numeri trovati nella tabella J:CU perché questo aumenterebbe notevolmente il tempo
Anche perché non vedo l'utilità

Fai sapere
Ciao

[Lucio Peruggini]

Sei sicuro di avere l'archivio distribuito così (un foglio per ogni ruota)?

Se così come fai ad aggiornare l'archivio?
Non vorrei che, alla fine, hai l'archivio con tutte le ruote inserite e bisogna rimettere le mani alle macro

ciao

Scusa l'assenza temporanea, stavo continuando questa ricerca manualmente.

Per quanto riguarda l'archivio l'ho messo su ruote separate semplicemente per provare ma giustamente mi fai rilevare che l'aggiornamento automatico creerebbe qualche difficoltà.

Intanto ti ringrazio e vado a provare questa macro.

[Flash30005]

Ok se vuoi compilata anche la tabella J:CU
puoi usare questa macro (tempo triplicato: 30 secondi)

Codice: Seleziona tutto

Sub ContaUnici2()
Start = Timer
Application.ScreenUpdating = False
Application.Calculation = xlManual
For FF = 1 To Worksheets.Count
If Len(Sheets(FF).Name) > 2 Then GoTo SaltaFF
Sheets(FF).Select
UR1 = Range("A" & Rows.Count).End(xlUp).Row
Range("CZ18:GK" & UR1).ClearContents
For RR1 = 2 To UR1 - 18 Step 18
    For NR = 1 To 90
        MyPre = Evaluate("=SUM(COUNTIF(B" & RR1 & ":F" & RR1 + 17 & "," & NR & "))")
        If MyPre = 1 Then
            UC1 = Cells(RR1 + 17, Columns.Count).End(xlToLeft).Column + 1
            If UC1 < 104 Then UC1 = 104
            Cells(RR1 + 17, UC1).Value = NR
        End If
    Next NR
Next RR1
UR2 = Range("CZ" & Rows.Count).End(xlUp).Row
For RR2 = 19 To UR2 Step 18
    UC2 = Cells(RR2, Columns.Count).End(xlToLeft).Column
    For CC2 = 104 To UC2
        NR = Cells(RR2, CC2).Value
        MyPre = Evaluate("=SUM(COUNTIF(B" & RR2 + 1 & ":F" & RR2 + 18 & "," & NR & "))")
        Cells(RR2 - 1, CC2).Value = MyPre
        If MyPre > 0 Then
            For RR3 = RR2 + 1 To RR2 + 18
                MyPre3 = Evaluate("=SUM(COUNTIF(B" & RR3 & ":F" & RR3 & "," & NR & "))")
                If MyPre3 = 1 Then Cells(RR3, NR + 9).Value = NR
            Next RR3
        End If
    Next CC2
Next RR2
SaltaFF:
Next FF
Sheets("BA").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Fine = Timer - Start
MsgBox "Elaborato in " & Int(Fine) & " sec"
End Sub


L'archvio ormai lo lasci così
Modificarla per un altro tipo di archivio comporterebbe notevole tempo per adattarla al nuovo schema
Rimane, anche se così, un ottimo strumento di analisi

ciao

[Lucio Peruggini]

"Mi hai preceduto stavo chiedendoti proprio questo"

Ciao Flash, ho controllato ed è già un grande aiuto ma il punto due altroché se è importante!
Anzi è il più importante!
Capisco che impiegherebbe tempo maggiore ma si potrebbe ovviare fornendogli uno step per x cicli che possono variare da uno a cento o più. Naturalmente, bisogna poterli scegliere; cioè quali esaminare. Cosa ne pensi?

Ciao

[Flash30005]

No, credo che si possa fare meglio
invece di ricalcolare tutto
calcolare solo dall'ultimo range elaborato all'ultima estrazione inserita
quindi il tempo si riduce solo al conteggio/valutazione di poche righe

Ciao