Valutazione 4.87/ 5 (100.00%) 5838 voti

Condividi:        

Excel Modifica alla Macro

Vuoi potenziare i tuoi documenti Word? Non sai come si fa una macro in Excel? Devi creare una presentazione in PowerPoint?
Oppure sei passato a OpenOffice e non sei sicuro di come lavorare al meglio?

Moderatori: Anthony47, Flash30005

Excel Modifica alla Macro

Postdi Statix » 30/04/09 23:45

Ciao a tutti,
ho bisogno di modificare questa macro,
la macro in oggetto mi evidenzia in colore la prima occorrenza di ogni numero,in questo caso 5 numeri (Range("Q2:AS2")
e fin quì è tutto ok.
il problema che ho è che ad ogni occorrenza deve cambiare anche il range di selezione.
i range di selezione sono 5
D8:M100
N8:W100
X8:AG100
AH8:AQ100
AR8:BA100
la macro mi deve evidenziare la prima occorrenza di un numero per ogni range di selezione,faccio un esempio della sequenza giusta
ho 5 numeri 1-2-3-4-5 faccio partire la macro
trova il numero 2 nel range AH8:AQ100
trova il numero 3 nel range D8: M100
trova il numero 5 nel range X8:AG100
trova il numero 1 nel range N8:W100
ed infine trova l'ultimo numero 4 nel range AR8:BA100,
quindi un numero per ogni range,questa è la sequenza giusta.

la macro in oggetto invece mi trova anche 3/4 numeri in un solo range vedi foto quella nel quadrato e giusta

Immagine

Codice: Seleziona tutto
Sub Bari/Cagliari()

Sheets("BiRuote").Select



i = 3
On Error Resume Next
For Each Ambo In Range("Q2:AS2")
Ambo.Offset(1, 0).Interior.ColorIndex = i
Ambo.Interior.ColorIndex = 3
Range("D8:M100").Select
Selection.Find(What:=Ambo, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, _
   SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
AAA = ActiveCell.Address
If ActiveCell.Address <> "$D$8" Then
ActiveCell.Interior.ColorIndex = i
Ambo.Interior.ColorIndex = 2
End If
i = i + 1
Next Ambo
Range("A2").Select
End Sub
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Sponsor
 

Re: Excel Modifica alla Macro

Postdi Statix » 30/04/09 23:50

errata corrige il numero in verde nel quadrato in rosso in realtà è il 55
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Modifica alla Macro

Postdi Anthony47 » 01/05/09 00:14

Se non sbaglio la macro in origine doveva trovare in una sequenza di range di cui il primo era D8:M100 tutti e 5 i numeri in Q3(?):Y3(?).
Adesso vuoi invece trovare il primo in un range, il secondo in un altro, e cosi' via.
C' e' un motivo per cui metti i numeri in una sequenza ma i range in cui cercare sono non in sequenza? Se Si (c' e' un motivo), allora la mia impressione e' che cancelli il ciclo For Each Ambo /Next Ambo e scrivi 5 blocchi di istruzioni col seguente schema:
Codice: Seleziona tutto
i = 3
On Error Resume Next
Ambo=Range("Q3").value     'INIZIO  BLOCCO 1
Range("N8:W100").Select
Selection.Find(What:=Ambo, After:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, _
   SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
If ActiveCell.Row <> 8 Then ActiveCell.Interior.ColorIndex = i
I=I+1
Ambo=Range("S3").value     'INIZIO  BLOCCO 2
Range("AH8:AQ100").Select
'etc


Ciao.
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13899
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Excel Modifica alla Macro

Postdi Statix » 01/05/09 00:35

Ciao Anthony
la sequenza non è giusta,
la macro in effetti deve prendere tutti i 5 numeri ,
evidenziare la prima occorrenza, cioè il primo numero che trova ed escludere sia il numero che il range dalla successiva ricerca sino allo sfaldamento dei 5 numeri uno per ogni range
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Modifica alla Macro

Postdi Statix » 01/05/09 13:42

Ciao ad Anthony e a tutti,
per meglio farvi comprendere la sequenza giusta allego un file Test Prova
nel foglio2 c'è la sequenza giusta che deve dare la macro.
Allegati

[L’estensione zip è stata disattivata e non puó essere visualizzata.]

Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Modifica alla Macro

Postdi Statix » 01/05/09 22:33

chiedo scusa ho sbagliato a inviare il file,questo è quello giusto per il test
Allegati

[L’estensione zip è stata disattivata e non puó essere visualizzata.]

Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Modifica alla Macro

Postdi Statix » 02/05/09 21:16

chiedo di nuovo scusa ,la sequenza giusta è questa, allego la foto.
Immagine
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Modifica alla Macro

Postdi Statix » 02/05/09 21:58

Come spiegato in precedenza la macro deve eseguire questa sequenza,come in foto.allegata post precedente

la tabella ha 5 range
D8:M8
N8:W8
X8:AG8
AH8:AQ8
AR8:BA8
e cinque numeri 1-2-3-4-5

prende il primo numero,(1)
lo controlla nella prima riga del range D8:M8
se non lo trova passa al secondo numero,(2)
se non lo trova passa al terzo numero,(3)
se non lo trova passa al quarto numero (4)
se lo trova lo colora(blu scuro) e scarta il numero (5)e il range.D8:M8.

rimangono 4 numeri(1-2-3-4) e quattro range

passa al successivo range N8:W8

prende i restanti 4 numeri(1-2-3-4) è ricomincia a trovarli
prende il primo numero(1)
lo controlla nella prima riga del range N8:W8
se non lo trova passa al secondo numero(2)
se non lo trova passa al terzo numero(3)
se non lo trova passa al terzo numero(5)
se non lo trova passa al range successivo


rimangono ancora quattro numeri(1-2-3-4) e quattro range

prende il primo numero(1)
lo controlla nel range X8:AG8
se lo trova lo colora(rosso) e scarta il numero(1)e il range X8:AG8

rimangono ancora 3 numeri(2-3-4) e tre range

si prende il primo numero(2)
lo controlla nel range AH8:AQ8
se lo trova lo colora(blu chiaro) e scarta il numero(2) e il range AH8:AQ8

rimangono ancora due numeri (3-5) e due range
passa al prossimo range AR8:BA8
prende il primo numero (3)
se lo trova lo colora(rosa) e scarta il numero(3) e il range AR8:BA8

rimane l'ultimo numero (4) e l'ultimo range N8:W8
quindi passa alla successiva riga del range N9:W9
prende il numero (4) e comincia a trovarlo
se non lo trova passa alla riga successiva
fino a trovarlo nel range N12:W12
ciclo concluso.zero numeri zero range.

La macro deve trovare un solo numero univoco per ogni range riga per riga
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Modifica alla Macro

Postdi Anthony47 » 04/05/09 18:23

Mamma mia, che contorsione... ma forse ho capito il "che cosa" (non capiro' invece mai il perche'...).

Devo ragionarci sopra per evitare di attorcigliarmi il filo attorno al collo.

Porta ancora pazienza, ciao.
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13899
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Excel Modifica alla Macro

Postdi Anthony47 » 05/05/09 23:59

Forse questa?

Codice: Seleziona tutto
Sub Tuttebis()
Dim DoneFlag(10)
PriRi = 8               '<< Prima riga di dati
LastRi = 14           '<< Ultima riga di dati
PriCel = "D8"         '<< Prima cella di dati


Sheets("BiRuote").Select
For Each Ambo In Range("Q2:Y2")
Ambo.Value = Val(Ambo.Value)
Next Ambo

On Error Resume Next
For Riga = 0 To LastRi - PriRi
For BiRuo = 1 To 5
i = 3
For Each Ambo In Range("Q2:Y2")
If Ambo = 0 Or Left(Ambo, 2) = "  " Then GoTo NAmbo   '<<**
If DoneFlag(BiRuo) > 0 Then GoTo NAmbo
Ambo.Offset(1, 0).Interior.ColorIndex = i
Range("D8:M8").Offset(Riga, BiRuo * 10 - 10).Select
If Application.WorksheetFunction.CountIf(Range("D8:M8").Offset(Riga, BiRuo * 10 - 10), Ambo) > 0 Then
Selection.Find(What:=Ambo, after:=ActiveCell, LookIn:=xlValues, LookAt:=xlWhole, _
   SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
ActiveCell.Interior.ColorIndex = i
Ambo.Value = "'  " & Ambo
DoneFlag(BiRuo) = 1
Exit For
End If
NAmbo:
i = i + 1
Next Ambo
Next BiRuo
Next Riga
Range("A2").Select
End Sub


Ciao.
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13899
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Excel Modifica alla Macro

Postdi Statix » 06/05/09 08:10

Ciao Anthony, che dire ?
grazie grazie grazie,sei fenomenale.
un ringraziamento anche da parte di Lucio P.
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Modifica alla Macro

Postdi Statix » 10/05/09 15:44

Ciao Anthony
per la macro mi è sorto un altro problema,
se nel range(Q2:Y2)
metto degli ambi
1-45 23-56 -34-12 1-67 24-88
la macro non mi funziona,gli ambi sono formato testo,
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Modifica alla Macro

Postdi Anthony47 » 10/05/09 15:54

La macro era nata per gestire numeri, mi pare, non stringhe.
Prova comunque a modificare questa istruzione:
Codice: Seleziona tutto
Sheets("BiRuote").Select
For Each Ambo In Range("Q2:Y2")
Ambo.Value = trim(Ambo.Value)       '<<<< MODIFICATA
Next Ambo

Se non va posta un file di esempio.

Ciao.
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13899
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Excel Modifica alla Macro

Postdi Statix » 10/05/09 16:07

Ciao Anthony
tutto ok. grazie infinite
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Modifica alla Macro

Postdi Statix » 22/05/09 13:48

Ciao Anthony
avrei bisogno di nuovo di fare una modifica alla macro.
la macro dovrebbe trovare almeno 2 numeri della cinquina in esame Range("Q2:Y2")
nel range D8:M100
una volta trovati,passare al prossimo range N8:W100 e ripetere di nuovo la stessa ricerca di 2 numeri della cinquina
quindi senza escludere i numeri ma solo i range .
i range sono sempre 5
D8:M100
N8:W100
X8:AG100
AH8:AQ100
AR8:BA100
la macro di prima escludeva sia il numero trovato che il range.
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Modifica alla Macro

Postdi Statix » 22/05/09 13:58

Dimenticavo una cosa importante ,la ricerca deve trovare 2 o più numeri nella stessa riga.
esempio se ho nel range ("Q2:Y2")
i numeri 1-2-3-4-5-
li deve trovare almeno 2 nel range D8:M8 altrimenti passa alla riga successiva
D9:M9 e cosi via una volta trovati,esempio in D20:M20, passare al prossimo range N8:R8 e fare la stessa ricerca dei 5 numeri finche non ne trova almeno 2 e passare al prossimo range S8:W8
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Modifica alla Macro

Postdi Statix » 22/05/09 18:29

allego un immagine di esempio

Immagine
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Modifica alla Macro

Postdi Anthony47 » 23/05/09 02:53

Ciao Statix; questo lavoro io lo farei con formule, e' molto piu' rapido che non col vba.
In un secondo foglio, per ogni estratto inserisci una formula tipo =Conta.se(Elenco-estratti;singolo numero), es
Codice: Seleziona tutto
=Conta.se($Q$2:$Y$2;D8)
che poi copi "in lungo e in largo"; ti fai quindi 5 riepiloghi di estratti con una formula del tipo
Codice: Seleziona tutto
=Se(Somma(D8:M8)>1;rif.riga(D8);9999)
che copi verso il basso per tutto l' elenco; calcoli per ognuno dei 5 range quale e' la riga dove figura la prima coppia con la formula
Codice: Seleziona tutto
=min(XY8:xy8888)
messa in XY1 (ho supposto che hai inserito la formula Se(Somma da XY8 a XY8888). Infine fai una formattazione condizionale selezionando un intero range e poi usando la formula
Codice: Seleziona tutto
=E(rif.riga()=$XY$1;conta.se($Q$2:$Y$2;D8)>0)

Ti assicuro che e' piu' facile a farsi che non a dirsi, quindi raccomando di provare.

Ciao.
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13899
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Excel Modifica alla Macro

Postdi Statix » 23/05/09 09:18

Ciao Anthony,
mi dispiace se forse mi sono espresso male,ma non posso farlo con le formule .
Il range Q2:Y2 che viene preso in esame,viene evidenziato nel archivio D8:BA4000 tramite la macro colorandoli,quindi mi trova tutte le occorrenze,dopodiche con un altra macro mi vado a controllare la fine del ciclo,cioè l'ultimo numero evidenziato,dopodiche la prima riga D8:BA8 viene eliminata o tot righe quante si impiegano per chiudere un ciclo a secondo della condizione che applico e riparte un altro ciclo, i valori del rangeQ2:Y2 cambiano a loro volta ad ogni ciclo,un altra macro mi memorizza i dati delle cinquine o numeri che non hanno terminato il ciclo.al termine l'archivio sarà completamente eliminato,in un altro foglio mi rimaranno i dati con i ritardi dei cicli non terminati.se voglio fare una nuova ricerca mi ricarico gli archivi.Ecco il motivo perche mi serve un macro.
Statix
Windows 7,
Office 2010,
Statix
Utente Senior
 
Post: 1078
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Modifica alla Macro

Postdi Anthony47 » 23/05/09 21:08

Come fedele utente del forum hai diritto anche a questa variante. Prova:
Codice: Seleziona tutto
Sub ppp()
Dim I As Single, J As Integer, K As Integer, CI As Integer, CJ As Integer
Dim Estra As Integer
'
LastR = Range("D" & Rows.Count).End(xlUp).Row
For J = 4 To 53 Step 10 'D to BA
For I = 8 To LastR
Estra = 0
For K = 0 To 9  'Scan una riga di estraz
Range("A1").Offset(I - 1, J - 1 + K).Select
Estra = Estra + Application.WorksheetFunction.CountIf _
        (Range("Q2:Y2"), Range("A1").Offset(I - 1, J - 1 + K))
Next K
If Estra >= 2 Then
For CI = 0 To 9 'in riga estrazioni
For CJ = 0 To 9 'in riga estratti
If Cells(I, J + CJ) = Cells(2, 17 + CI) Then
Cells(I, J + CJ).Interior.ColorIndex = Cells(2 + 1, 17 + CI).Interior.ColorIndex
End If
Next CJ
Next CI
GoTo NRuota
End If
Next I
NRuota:
Next J
End Sub

Ciao
Anthony
Win7 + Office 2010 Ita; Win 7 + Office 2013 Ita
Xp + Office 2003 Ita
E voi cosa usate? (per istruzioni vedere viewtopic.php?f=26&t=97449)
Avatar utente
Anthony47
Moderatore
 
Post: 13899
Iscritto il: 21/03/06 16:03
Località: Ivrea

Prossimo

Torna a Applicazioni Office Windows


Topic correlati a "Excel Modifica alla Macro":


Chi c’è in linea

Visitano il forum: Nessuno e 14 ospiti