Ho una serie di 9000 codici a 9 numeri composti dal num. 1 2 e 3 esempio:
112123131
313222112
232113311 eccetera fino a 9000 num. diversi.
Vorrei sapere se e' possibile trovare uno o piu' formule che mi permettono di trovare la differenza numerica in colonna tra le righe.
Cioe' come da esempio:
112123131
313222112 3-1=2 poi 1-1=0 3-2=1 e cosi via
201101021= Diff. tot 8
i valori negativi si traformano sempre in positivi .
in questo modo ho la diff. totale tra due serie di codici.
Dovrei trovare la differenza di codice di ognuno dei 9000 num. rispetto gli altri.
Grazie per l'eventuale aiuto.

spero bene per te che sia un lavoro una-tantum e che il controllo dei records sia tra il primo e il secondo tra il secondo e il terzo e via discorrendo e non tra un codice e tutti gli altri 8999 della lista.
Bene, se ho interpretato in maniera corretta, la macro richiede diversi cicli For che inevitabilmente assorbono memoria di calcolo. Ho provato con 9000 codici e il tempo di elaborazione con il mio PC è di circa 10 secondi ( una vita se rapportato alla capacità di calcolo)
Premetto che la macro necessita di colonne di appoggio per i calcoli che non ho fatto cancelare dalla macro perchè non so se possono essere utili. Ho previsto che in colonna A dalla riga 1 inizi l'elenco dei codici, le colonne da "B" a "J" ricevono il risultato della sottrazione dei valori indivisuali, la colonna "L" riporta il totale della differenza del record analizzato.
Nel caso che le colonne che ho considerato per appoggiarmi non siano libere, ti inviterei a crearti un foglio di prova con pochi records e lanciare da li la macro.
questa che segue è la macro (non ti spaventare ma non ho saputo fare di meglio)

Sub calcoli()
Application.ScreenUpdating = False
Set area = Range(Cells(1, 1), Cells(1, 1).End(xlDown))
For Each cl In area
If cl.Offset(1, 0) = "" Then GoTo 10
c1 = Mid(cl, 1, 1)
c2 = Mid(cl, 2, 1)
c3 = Mid(cl, 3, 1)
c4 = Mid(cl, 4, 1)
c5 = Mid(cl, 5, 1)
c6 = Mid(cl, 6, 1)
c7 = Mid(cl, 7, 1)
c8 = Mid(cl, 8, 1)
c9 = Mid(cl, 9, 1)
d1 = Mid(cl.Offset(1, 0), 1, 1)
d2 = Mid(cl.Offset(1, 0), 2, 1)
d3 = Mid(cl.Offset(1, 0), 3, 1)
d4 = Mid(cl.Offset(1, 0), 4, 1)
d5 = Mid(cl.Offset(1, 0), 5, 1)
d6 = Mid(cl.Offset(1, 0), 6, 1)
d7 = Mid(cl.Offset(1, 0), 7, 1)
d8 = Mid(cl.Offset(1, 0), 8, 1)
d9 = Mid(cl.Offset(1, 0), 9, 1)
cl.Offset(1, 1).Select
ActiveCell = c1 - d1
ActiveCell.Offset(0, 1) = c2 - d2
ActiveCell.Offset(0, 2) = c3 - d3
ActiveCell.Offset(0, 3) = c4 - d4
ActiveCell.Offset(0, 4) = c5 - d5
ActiveCell.Offset(0, 5) = c6 - d6
ActiveCell.Offset(0, 6) = c7 - d7
ActiveCell.Offset(0, 7) = c8 - d8
ActiveCell.Offset(0, 8) = c9 - d9
Next
10:
x = -1
Set area = Nothing
Set area2 = Range(Cells(2, 2), Cells(2, 10).End(xlDown))
For Each clx In area2
If clx ( 0 Then
y = clx.Value * x
clx.Select
ActiveCell = y
End If
Next
Set area2 = Nothing
Set area3 = Range(Cells(2, 2), Cells(2, 2).End(xlDown))
For Each nr In area3
Set area4 = Range(nr, nr.Offset(0, 9))
If nr () "" Then
totale = Application.WorksheetFunction.Sum(area4)
nr.Offset(0, 10).Select
ActiveCell = totale
End If
Next
Set area3 = Nothing
Set area4 = Nothing
Application.ScreenUpdating = True
End Sub

prova a fa sapere se ci ho azzeccato.
saluti
Andrea

in questa riga al posto della parentesi tonda usa il segno di "minore"
If clx < 0 Then

In quests'altra riga al posto delle parentes tonde il segno di "Diverso"
If nr <) "" Then


Edited by - a10n11 on 07/18/2005 22:07:08

---

da come mi dici ora No la macro non effettua quel tipo di controllo.
In questo nuovo caso l'elaborazione presumo che diventi pesantissima vista la quantità di records da elaborare.
In giornata provo a darci un'occhiata.
saluti
Andrea

---

Ho provato la macro, e' proprio quello che volevo. Complimenti e molte grazie per l'aiuto.
Mi rimane il problema di mancanza di colonne utili per lo sviluppo del calcolo.
Come ho potuto osservare , non riesco a calcolare piu' di 256 codici.
Ancora una volta ti chiedo se questo e' un limite insormontabile o si puo' fare qualcosa, tipo lo sviluppo su piu' fogli??
Grazie ancora per la disponibilita'.
Ciao

ora la situazione migliora un po.
ti ho modificato la macro in questo modo:
se la differenza della comparazione da' come risultato "2" colora la cella che contiene il codice controllato.
questa è la modifica che devi fare al codice postato ieri:

For Each nr In area3
Set area4 = Range(nr, nr.Offset(0, 8))
area4.Select
If nr () "" Then
area4.Select
totale = Application.WorksheetFunction.Sum(area4)
End If
If totale = 2 Then
Cells(k, 1).Select
With Selection
.Interior.ColorIndex = 7
End With
End If
k = k + 1
Next nr
area2.Select
Selection.ClearContents
Next h


sostituisci tutta questa sezione
saluti
Andrea

Edited by - a10n11 on 07/20/2005 10:03:27

---

l'avevo detto che per controllare 9000 record composti da nove caretteri era una cosa colossale.
La macro l'ho ricontrollata e pare che vada bene. Riepilogo quello che fa.
dati i seguenti valori:
123213213 (1)
113223213 (2)
112213213 (3)
222221312 (4)
differenza tra 1 - 2 = 2
differenza tra 1 - 3 = 2
differenza tra 1 - 4 = 7
differenza tra 2 - 3 = 2
differenza tra 2 - 4 = 7
differenza tra 3 - 4 = 7
stante questi risultati la macro marca il secondo e terzo valore in quanto restituiscono il valore =2.
E' questo che mi pareva di aver capito dalla tua domanda.
Nel caso che si omettese il controllo dei records marcati con i suoi successivi cambierebbe la logica del controllo.
saluti
Andrea

---

Prova a vedere se così va bene.
Nb: invece di provarla su un range molto esteso provala con pochi records
onde evitare una lunga elaborazione che magari non è ancora come vorresti.
Ho anche cercato di snellirla un po.



Sub elabora()
Application.ScreenUpdating = False
Sheets("foglio1").Select

Dim cl
colonna = 2
r = Range(Cells(1, 1), Cells(1, 1).End(xlDown)).Rows.Count
For h = r To 2 Step -1
If Range("a" & h).Interior.ColorIndex = 7 Then GoTo fine2
x = -1
cl = Range("a" & h).Value
Range("a" & h).Select
riga = -1
y = -1
Do
If h + y = 0 Then Exit Do
If ActiveCell.Offset(y, 0).Interior.ColorIndex () 7 Then
c1 = Mid(cl, 1, 1)
c2 = Mid(cl, 2, 1)
c3 = Mid(cl, 3, 1)
c4 = Mid(cl, 4, 1)
c5 = Mid(cl, 5, 1)
c6 = Mid(cl, 6, 1)
c7 = Mid(cl, 7, 1)
c8 = Mid(cl, 8, 1)
c9 = Mid(cl, 9, 1)
d1 = Mid(ActiveCell.Offset(y, 0), 1, 1)
d2 = Mid(ActiveCell.Offset(y, 0), 2, 1)
d3 = Mid(ActiveCell.Offset(y, 0), 3, 1)
d4 = Mid(ActiveCell.Offset(y, 0), 4, 1)
d5 = Mid(ActiveCell.Offset(y, 0), 5, 1)
d6 = Mid(ActiveCell.Offset(y, 0), 6, 1)
d7 = Mid(ActiveCell.Offset(y, 0), 7, 1)
d8 = Mid(ActiveCell.Offset(y, 0), 8, 1)
d9 = Mid(ActiveCell.Offset(y, 0), 9, 1)
ActiveCell.Offset(0, 1).Select
If d1 - c1 ( 0 Then
ActiveCell.Offset(riga, 0) = (d1 - c1) * x
Else
ActiveCell.Offset(riga, 0) = (d1 - c1)
End If

If d2 - c2 < 0 Then
ActiveCell.Offset(riga, 1) = (d2 - c2) * x
Else
ActiveCell.Offset(riga, 1) = (d2 - c2)
End If

If d3 - c3 < 0 Then
ActiveCell.Offset(riga, 2) = (d3 - c3) * x
Else
ActiveCell.Offset(riga, 2) = (d3 - c3)
End If
If d4 - c4 < 0 Then
ActiveCell.Offset(riga, 3) = (d4 - c4) * x
Else
ActiveCell.Offset(riga, 3) = (d4 - c4)
End If
If d5 - c5 < 0 Then
ActiveCell.Offset(riga, 4) = (d5 - c5) * x
Else
ActiveCell.Offset(riga, 4) = (d5 - c5)
End If
If d6 - c6 < 0 Then
ActiveCell.Offset(riga, 5) = (d6 - c6) * x
Else
ActiveCell.Offset(riga, 5) = (d6 - c6)
End If
If d7 - c7 < 0 Then
ActiveCell.Offset(riga, 6) = (d7 - c7) * x
Else
ActiveCell.Offset(riga, 6) = (d7 - c7)
End If
If d8 - c8 < 0 Then
ActiveCell.Offset(riga, 7) = (d8 - c8) * x
Else
ActiveCell.Offset(riga, 7) = (d8 - c8)
End If
If d9 - c9 < 0 Then
ActiveCell.Offset(riga, 8) = (d9 - c9) * x
Else
ActiveCell.Offset(riga, 8) = (d9 - c9)
End If

Else
ActiveCell.Offset(riga, 1) = 10
ActiveCell.Offset(riga, 2) = 10
ActiveCell.Offset(riga, 3) = 10
ActiveCell.Offset(riga, 4) = 10
ActiveCell.Offset(riga, 5) = 10
ActiveCell.Offset(riga, 6) = 10
ActiveCell.Offset(riga, 7) = 10
ActiveCell.Offset(riga, 8) = 10
ActiveCell.Offset(riga, 9) = 10


End If
Range("a" & h).Select
y = y - 1

riga = riga - 1


Loop
ActiveCell.Select
If h = 2 Then GoTo dopo
Set area3 = Range(Cells(1, 2), Cells(1, 2).End(xlDown))
area3.Select
For Each nr In area3
If nr.Offset(0, -1).Interior.ColorIndex = 7 Then GoTo fine
area3.Select
Set area4 = Range(nr, nr.Offset(0, 8))
area4.Select
If nr <) "" Then
area4.Select
TOTALE = Application.WorksheetFunction.Sum(area4)

nr.Offset(0, 9) = TOTALE
End If

If TOTALE = 2 Then
nr.Offset(0, -1).Interior.ColorIndex = 7
End If
fine:
Next nr
GoTo fine2
dopo:
Set Areas = Range(Cells(1, 2), Cells(1, 2).End(xlToRight))
TOTALE = Application.Sum(Areas)
ActiveCell.Select
ActiveCell.Offset(-1, 10) = TOTALE
If TOTALE = 2 Then
ActiveCell.Interior.ColorIndex = 7
End If
fine2:
Columns("b:k").Select
Selection.ClearContents
Range("a1").Select
Next h
Set area3 = Nothing
Set area4 = Nothing
Application.ScreenUpdating = True
End Sub

saluti
Andrea

---