Excel 2007 Macro per sostituire numeri in più tabelle

[max2011]

Salve, avrei bisogno di una macro che mi sostituisce i numeri in tutte le tabelle.
Le tabelle sono molte e sono in fogli numerati. Le matrici sono composte da numeri che vanno da 0 a 36.
i numeri che dovrei sostituire in tutte le tabelle sono 888 e mi spiego meglio:
ogni rigo a i numeri da 0 a 36
lo 0 rimane sempre uguale mentre devo sostituire i numeri che vanno da 13 a 36
i numeri sono questi
1 - 13 -25 = 1 - 1 - 1
2 -14 -26 = 2 -2 - 2
3 -15 -27 = 3 -3 -3
4 -16 -17 = 4 -4 -4
5 -17 - 18= 5 -5 -5
6 -18 - 19 = 6 -6 -6
e così fino a 12.
Alla fine avrò una matrice con tre 1 , tre 2 , tre 3 etc....
Questo devofarlo per tutte le matrici.
Posto solo tre tabelle ma ne sto facendo altre
Allego file

http://www.fileserve.com/file/4pfz7sS/file sostituisci.xlsx


Grazie per l'aiuto

[Flash30005]

Vorrei aiutarti ma non mi è chiaro quali sono i numeri che devi sostituire
Invia un'immagine del tuo Foglio1 evidenziando (almeno per due o tre righe) i numeri sostituiti secondo il concetto postato

ciao

[max2011]

Ciao Flash,
grazie della risposta. Ti posto il file con i primi 3 righi felfoglio 1 modificati.

http://www.fileserve.com/file/EAWZyED/file sostituiscimodificato.xlsx

Grazie ancora

[max2011]

http://www.fileserve.com/file/EAWZyED/file sostituiscimodificato.xlsx

[Flash30005]

Ehmmm
Purtroppo devo dirti che non ho capito con quale regola vengono sostituiti i numeri.

Sei sicuro di aver inviato l'esempio giusto?

Ciao

[Anthony47]

Ho guardato il file, e anche io non ho capito quale regola usare per decidere quale numero sostituire con quale.
Nell' ipotesi che si tratti di cercare su tutti i fogli tutti i 13 e mutarli in 1, poi tutt i 14 e mutarli in 2, poi tutti i 15 e mutarli in 3 e cosi' via allora potresti usare una macro come questa:

Codice: Seleziona tutto

Sub max20()
Dim DAmatr, Amatr
DAmatr = Array(13, 14, 15, 16)   'tutti i numeri da sostituire
Amatrr = Array(111, 222, 333, 444)  'tutti i sostituti
For I = LBound(DAmatr, 1) To UBound(DAmatr, 1)
    For J = 1 To ThisWorkbook.Worksheets.Count
        Sheets(J).Cells.Replace What:=DAmatr(I), Replacement:=Amatrr(I), LookAt:=xlWhole, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                ReplaceFormat:=False
    Next J
Next I
End Sub


Compila le prime due matrici con l' elenco dei numeri da cercare (in DAmatr) e (rispettando la sequenza, in Amatrr) i numeri con cui sostituire.

Se non e' quello che devi fare prova a descrivere nuovamente.

Ciao

[max2011]

Grazie mille,
perfettissimo è quello che mi serviva, funziona benissimo.

Ciaoooooooooooo e grazie per il lavoro che fate

[max2011]

Salve,
la macro è perfetta, solo che i numeri in rosso che vanno da 1 a 37 sia i verticali che gli orizzontali non dovrebbero cambiare.

Grazie ancora per tutto.

Ciaooooooooooo

[Flash30005]

Anche questa sostituisce i numeri

Ma i numer1 dal 22 al 24 (e quindi dal 34 al 36) con cosa devono essere sostituiti?
22 e 34 da 1110
23 e 35 da 1221
24 e 36 da 1332 o da 0 ?

Codice: Seleziona tutto

Sub SostM()
For J = 1 To ThisWorkbook.Worksheets.Count
    For I = 13 To 37
        For RR = 2 To 38
            For CC = 2 To 38
                S = (I Mod 12) * 111
                If S = 0 Then S = 12 * 111  '<<<< eliminare questa riga se con 12 e 24 si vuole ottenere zero
                If Cells(RR, CC).Value = I Then Cells(RR, CC).Value = S
            Next CC
        Next RR
    Next I
Next J
End Sub


Ciao

[max2011]

Salve,
posto la macro modificata che funziona perfettamente, ma mi cambia anche i numeri in rosso che non vorrei far cambiare.
La tua macro flash non mi cambia i numeri in rosso ma nelle tabelle non sono quelli i numeri che devo mettere, i numeri sono quelli della macro postata.
Praticamente mi occorrerebbe una modifica alla macro.
Grazie ancora per la disponibilità.


Ciaooooooooooooo


Sub max20()
Dim DAmatr, Amatr
DAmatr = Array(13, 14, 15, 16, 17, 18, 19, 20, 21, 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35, 36) 'tutti i numeri da sostituire
Amatrr = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12) 'tutti i sostituti
For I = LBound(DAmatr, 1) To UBound(DAmatr, 1)
For J = 1 To ThisWorkbook.Worksheets.Count
Sheets(J).Cells.Replace What:=DAmatr(I), Replacement:=Amatrr(I), LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Next J
Next I
End Sub

[Flash30005]

Codice: Seleziona tutto

Sub SostM()
For J = 1 To ThisWorkbook.Worksheets.Count
    For I = 13 To 37
        For RR = 2 To 38
            For CC = 2 To 38
                S = I Mod 12
                If S = 0 Then S = 12
                If Cells(RR, CC).Value = I Then Cells(RR, CC).Value = S
            Next CC
        Next RR
    Next I
Next J
End Sub


così?
ciao

[max2011]

Flash è questa la macro che intendevo solo che lavora su un solo foglio, se aggiungo altri fogli si blocca.
Quella postata da me l'ho fatta lavorare su su più di 300 fogli e in 10 minuti circa li modificava, solo che ovviamente i numeri sopra me li cambiava.

Mi servirebbe che lavorasse su più fogli.
Grazie mille ancora

[Anthony47]

Con la macro che avevo suggerito inizialmente, non
Sheets(J).Cells.Replace What:=DAmatr(I), Replacement:=Amatrr(I), LookAt:=xlWhole, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False

MA

Codice: Seleziona tutto

        Sheets(J).UsedRange.Offset(1, 1).Replace What:=DAmatr(I), Replacement:=Amatrr(I), LookAt:=xlWhole, _
                SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
                ReplaceFormat:=False


Ciao

[max2011]

Grazie mille, risolto.

Ringrazio tantissimo per l'aiuto sia a te Anthony che a Flash, siete mitici e bravissimi

Ciaoooooooooooooooooooooooo

[Flash30005]

Mi servirebbe che lavorasse su più fogli.

Hai ragione Max2011
avevo dimenticato la ricerca sugli altri fogli
modificando solo la riga evidenziata

Codice: Seleziona tutto

Sub SostM()
Application.Calculation = xlManual
For J = 1 To ThisWorkbook.Worksheets.Count  '<<<<< aggiunta riga per velocizzare (ferma il calcolo automatico)
    For I = 13 To 37
        For RR = 2 To 38
            For CC = 2 To 38
                S = I Mod 12
                If S = 0 Then S = 12
                If Sheets(J).Cells(RR, CC).Value = I Then Sheets(J).Cells(RR, CC).Value = S  '<<<< modificare questa
            Next CC
        Next RR
    Next I
Next J
Application.Calculation = xlCalculationAutomatic   '<<<<< aggiunta riga per ripristino calcolo automatico
End Sub

Ciao

[max2011]

Grazie Flash,
perfetto

Ciaoooooooooooooo