MACRO O FORMULA

[Lucio Peruggini]

Indipendentemente dal file, non abbiamo mica due archivi diversi?

Range B3:F20 =

49 univoci
41 doppioni
Di cui il 78 è presente tre volte
Totali 90 numeri

https://dl.dropbox.com/u/18220462/IMMAGINI/UNIVOCI.PNG

dalla riga 19

https://dl.dropbox.com/u/18220462/IMMAG ... a%2019.PNG

[Flash30005]

Io non so dove tu abbia preso quell'archivio o cosa abbia fatto all'archivio originale
perché io alla riga 3 ho il concorso 3950 e non 5000
Vedi immagine


Uploaded with ImageShack.us


Se manometti il file e poi fai riferimento su cose che non ho perdiamo solo tempo inutilmente


ciao

[Lucio Peruggini]

Abbi pazienza, io stavo ragionando con il file che ho inviato la prima volta con l’archivio che parte dall’estrazione 5000. Non ho preso nulla a casaccio!

Ad ogni modo cerchiamo di riprendere la matassa, ok?
Partenza 3950

Range C3:G20, gli univoci sono 33 ma in CZ20:EC20 ne conto solamente 30 dei quali:

Il numero 5 non deve esserci, trattasi di un doppione e non univoco.
Il 26 neanche, doppione.
27 altro doppione.

Non li controllo tutti ma è evidente che la stringa ha errori.





Ciao

[Flash30005]

Ho capito dov'è nato l'inghippo o il bug
da un cero momento in poi si è aggiunta una colonna nel foglio di ogni ruota
La colonna B con il nome Ruota e quindi la macro forniva dati errati nel senso che la colonna G non veniva conteggiata
per questo alcuni numeri doppi venivano riportati e non venivano aggiunti numeri (come il 2) che si trovavano sulla colonna G

Per il nuovo archivio usa queste due macro

Codice: Seleziona tutto

Sub ContaUnici()
Risp = MsgBox(Prompt:="Attenzione stai per cancellare i dati già elaborati - Continuo?", Buttons:=vbYesNo)
If Risp = 6 Then
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("CV3:GK" & UR1).ClearContents
Range("J3:CU" & UR1).ClearContents
For RR1 = 3 To UR1 - 18 Step 18
    For NR = 1 To 90
        MyPre = Evaluate("=SUM(COUNTIF(C" & RR1 & ":G" & 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 Passo = 1 To 5
For RR2 = 20 To UR2 Step 18
    UC2 = Cells(RR2, Columns.Count).End(xlToLeft).Column
    For CC2 = 104 To UC2
        NR = Cells(RR2, CC2).Value
       
        If Passo = 1 Then
            MyPre = Evaluate("=SUM(COUNTIF(C" & (RR2 + 1) + (Passo - 1) * 18 & ":G" & (RR2 + 18) + (Passo - 1) * 18 & "," & NR & "))")
            Cells(RR2 - 1 - (Passo - 1), CC2).Value = MyPre
            If MyPre > 0 Then
                For RR3 = RR2 + 1 To RR2 + 18
                    MyPre3 = Evaluate("=SUM(COUNTIF(C" & RR3 & ":G" & RR3 & "," & NR & "))")
                    If MyPre3 = 1 Then Cells(RR3, NR + 9).Value = NR
                Next RR3
            End If
            Range("CX" & RR2 - 1 - (Passo - 1)).Value = Passo * 18
        Else
            myform = "=MAX(R" & RR2 - 1 & "C" & CC2 & ":R" & RR2 - Passo + 1 & "C" & CC2 & ")"
            If Application.ReferenceStyle = xlA1 Then myform = Application.ConvertFormula(myform, xlR1C1, xlA1)
            MyMax = Evaluate(myform)
            If MyMax = 0 Then
                MyPre = Evaluate("=SUM(COUNTIF(C" & (RR2 + 1) + (Passo - 1) * 18 & ":G" & (RR2 + 18) + (Passo - 1) * 18 & "," & NR & "))")
                Cells(RR2 - 1 - (Passo - 1), CC2).Value = MyPre
                Range("CX" & RR2 - 1 - (Passo - 1)).Value = Passo * 18
            End If
        End If
    Next CC2
    Range("CW" & RR2 - 1 - (Passo - 1)).Value = Evaluate("=SUM(COUNTIF(CZ" & RR2 - 1 - (Passo - 1) & ":IV" & RR2 - 1 - (Passo - 1) & "," & 0 & "))")
    Range("CW" & RR2).Value = Evaluate("=SUM(CW" & RR2 - 10 & ":CW" & RR2 - 1 & ")")
    Range("CV" & RR2).Value = "Tot"
Next RR2
Next Passo
SaltaFF:
Next FF
ContaRitardi
Sheets("BA").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Fine = Timer - Start
MsgBox "Elaborato in " & Int(Fine) & " sec"
End If
End Sub

Sub ContaUniciAgg()
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
UR2 = Range("CZ" & Rows.Count).End(xlUp).Row
For RR1 = UR2 To UR1 - 18 Step 18
    For NR = 1 To 90
        MyPre = Evaluate("=SUM(COUNTIF(C" & RR1 & ":G" & 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 Passo = 1 To 5
For RR2 = UR2 - 18 * 5 To UR1 Step 18
    UC2 = Cells(RR2, Columns.Count).End(xlToLeft).Column
    For CC2 = 104 To UC2
        NR = Cells(RR2, CC2).Value
        If Passo = 1 Then
            MyPre = Evaluate("=SUM(COUNTIF(C" & RR2 + 1 & ":G" & RR2 + 18 & "," & NR & "))")
            Cells(RR2 - 1, CC2).Value = MyPre
            If MyPre > 0 Then
                For RR3 = RR2 + 1 To RR2 + 18
                    MyPre3 = Evaluate("=SUM(COUNTIF(C" & RR3 & ":G" & RR3 & "," & NR & "))")
                    If MyPre3 = 1 Then Cells(RR3, NR + 9).Value = NR
                    Range("CX" & RR2 - 1 - (Passo - 1)).Value = Passo * 18
                Next RR3
            End If
        Else
            myform = "=MAX(R" & RR2 - 1 & "C" & CC2 & ":R" & RR2 - Passo + 1 & "C" & CC2 & ")"
            If Application.ReferenceStyle = xlA1 Then myform = Application.ConvertFormula(myform, xlR1C1, xlA1)
            MyMax = Evaluate(myform)
            If MyMax = 0 Then
                MyPre3 = Evaluate("=SUM(COUNTIF(C" & (RR2 + 1) + (Passo - 1) * 18 & ":G" & (RR2 + 18) + (Passo - 1) * 18 & "," & NR & "))")
                Cells(RR2 - 1 - (Passo - 1), CC2).Value = MyPre3
                Range("CX" & RR2 - 1 - (Passo - 1)).Value = Passo * 18
            End If
        End If
    Next CC2
     Range("CW" & RR2 - 1 - (Passo - 1)).Value = Evaluate("=SUM(COUNTIF(CZ" & RR2 - 1 - (Passo - 1) & ":IV" & RR2 - 1 - (Passo - 1) & "," & 0 & "))")
    Range("CW" & RR2).Value = Evaluate("=SUM(CW" & RR2 - 10 & ":CW" & RR2 - 1 & ")")
    Range("CV" & RR2).Value = "Tot"
Next RR2
Next Passo
SaltaFF:
Next FF
ContaRitardi
Sheets("BA").Select
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Fine = Timer - Start
MsgBox "Elaborato in " & Int(Fine) & " sec"
End Sub

Ciao

[Lucio Peruggini]

Ok, ti ringrazio!!!
Notte

[Lucio Peruggini]

Buona serata, avrei bisogno del vostro prezioso aiuto anche per questa formula.

In J3:BG3 devo segnare i numeri univoci che si trovano in C3:G19.

La medesima formula devo poterla utilizzare anche J22:BG22 e J41:BG41 e eventualmente anche oltre.
GRAZIE

Allego file
https://dl.dropbox.com/u/18220462/FILE/ ... FORUM.xlsx

[Lucio Peruggini]

Scusatemi ma ho dimenticato un particolare molto importante.
I numeri nella stringa devono essere inseriti in un'unica cella unita e separati da un punto (.)

2.4.5.8.11.18.19.25.26.28.37.41.43 etc.

Ciao

[Anthony47]

Stavo per rispondere

In J3:

Codice: Seleziona tutto

=SE(CONTA.SE($C3:$G19;J$1)=1;J$1;"")

Copia poi verso destra e poi in J22:BG22 e J41:BG41

Ma la tua ultima precisazione mi ha spiazzato: di quale stringa parli?

Ciao

[Lucio Peruggini]

No Anthony, forse mi sono spiegato male?

J3:BG3 sono una cella unica dentro la quale, i numeri inseriti e separati da un punto (.) sono gli univoci del range C3:G19

Seleziono J3:BG3 e trasformo le celle singole in unica cella unita.
ciao

[Anthony47]

Mah... a che serve?
Metti questo codice in un modulo vba

Codice: Seleziona tutto

Function inutile(ByRef myR As Range) As String
For I = 1 To 90
If Application.WorksheetFunction.CountIf(myR, I) = 1 Then myInut = myInut & "." & I
Next I
inutile = Mid(myInut, 2, 9999)
End Function


Poi userai la formula

Codice: Seleziona tutto

=inutile(C3:G19)

Ciao

[Lucio Peruggini]

A cosa serve? Ti riferisci alla stringa o altro?

Provo questi codici, grazie.

[Lucio Peruggini]

Scusa, come inserisco questo codice in un modulo?
Le celle unite, le fa in automatico o le faccio io?

=inutile(C3:G19)

Questa dove la incollo?

Grazie

[Lucio Peruggini]

Ci sono arrivato ma non riesco a incollare questi numeri così composti. il formato deve venir fuori come testo.
Questi numeri devo prenderli e incollarli in un programma laddove richiede per l'appunto il formato "testo".

Ora ho capito anche la tua domanda del perché averli in quel modo.
Ciao

[Anthony47]

Usa il codice come una qualsiasi macro; metti la formula dove vuoi tu, ad esempio in J3.
Le celle unite io e odio, quindi te le devi unire da solo.
Per gli altri intervalli userai una formula analoga; anzi puoi copiare J3 in J22 e poi J41

Ciao

[Anthony47]

Lascia stare le formule (anche se non capisco perche' non riesci a incollare il risultato) e aggiungi quest' altro codice:

Codice: Seleziona tutto

Sub Inut()
Range("J3") = Inutile(Range("C3:G19"))
Range("J22") = Inutile(Range("C22:G38"))
Range("J42") = Inutile(Range("C41:G57"))
End Sub


Poi manda in esecuzione la Inut

Ciao

[Lucio Peruggini]

Sempre meglio, grazie.
Il fatto di non poter incollare dipende dal programma. Se non proviene da un file di testo, non l'accetta. Comunque, come detto, ho risolto incollando su txt.
Ciao

[Flash30005]

Beh!
Allora scrivi direttamente nel file.txt le tre (o più righe) che ti occorrono

Ciao

[Lucio Peruggini]

No! Cosa faccio, anziché guadagnar tempo e lavoro, lo moltiplico?
Dal foglio Excel copio e incollo sul blocco note ed è fatto.
Ciao

[Flash30005]

?
Io credo che farai almeno un'operazione in meno
non avere la stringa su excel che devi copiare e inserirla nel blocco note
ma far inserire dalla macro la stringa in un file testo (tipo blocco note).
A meno che non intendi solo memorizzarla negli "appunti" come lo vorrebbe un certo programma che conosco...

Ciao

[Lucio Peruggini]

Hai azzeccato!
Il motivo era proprio quello. Comunque stato risolto, grazie.
Ciao