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

Re: Excel Modifica alla Macro

Postdi Statix » 23/05/09 22:05

Ciao Anthony,
ho provato la macro funziona perfettamente,
dopo un attento esame ,ho riscontrato 2 errori di valutazione da parte mia nell'esporti il problema.
1° Non ho valutato i numeri ripetuti nei range ,quindi se in un range ci sono e solo 2 numeri uguali ,non è valido
D9:M9
N9:W9
X9:AG9
AH9:AQ9
AR9:BA9
quindi la macro dovrebbe saltare i numeri ripetuti

2° Per ogni Range i numeri trovati devono essere di un solo colore,tanto per fare un esempio,
D9:M9 rosso
N9:W9 giallo
X9:AG9 verde
AH9:AQ9 blu
AR9:BA9 Rosa
il motivo dei colori e perchè oltre ad avere il riferimento dei ritardi devo capire anche su quale biRuote non si è sfaldato,uso i riferimenti come una battaglia navale,trovato il numero/i mi trovo le coordinate.
Lo so che ti chiedo tanto,se è possibile.Grazie.
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Sponsor
 

Re: Excel Modifica alla Macro

Postdi Statix » 23/05/09 22:32

Ti posto qui una foto,come vedi dagli estratti evidenziati in colore dalla macro,mi ricavo da ogni numero il ritardo e il Biruote sfaldati,ogni tabella trova un solo colore
Immagine
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Modifica alla Macro

Postdi Anthony47 » 25/05/09 00:44

Ho fatto leggere modifiche per il problema dei numeri doppi e per evidenziare i numeri dell' elenco non secondo il colorindex presenti in Q3:Y3 ma con dei colori diversi a livello di ogni blocco di 10 colonne.
La nuova macro e' questa:
Codice: Seleziona tutto
Sub pppbis()
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
ColoInd = 3
For J = 4 To 53 Step 10 'D to BA
For I = 8 To LastR
Estra = 0: K = 0: FiCol = Range("A1").Offset(I - 1, J - 1 + K).Address
For K = 0 To 9  'Scan una riga di estraz
Range("A1").Offset(I - 1, J - 1 + K).Select
If Application.WorksheetFunction.CountIf(Range(Range(FiCol), Range("A1").Offset(I - 1, J - 1 + K)), _
       Range("A1").Offset(I - 1, J - 1 + K).Value) < 2 Then
Estra = Estra + Application.WorksheetFunction.CountIf _
        (Range("Q2:Y2"), Range("A1").Offset(I - 1, J - 1 + K))
End If
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
Cells(I, J + CJ).Interior.ColorIndex = ColoInd
End If
Next CJ
Next CI
GoTo NRuota
End If
Next I
NRuota:
ColoInd = ColoInd + 1
Next J
End Sub

L' immagine dell' ultimo tuo post non mi pare attinente a questo quesito, ma forse a viewtopic.php?f=26&t=80468; quindi la ignoro.

Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Excel Modifica alla Macro

Postdi Statix » 25/05/09 09:18

Ciao Anthony,
al momento mi sembra tutto ok. grazie
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Modifica alla Macro

Postdi Statix » 26/05/09 23:17

Ciao Anthony
scusami se ti disturbo ancora,
ho fatto una modifica al range Q2:Y2 (il range è composto da 10 celle,unitea 2 alla volta)
con il range N3:R3 (il range è composto da 5 singole celle)
ho provato a fare qualche modifica alla macro ma non mi funziona bene.
un piccolo aiuto grazie.
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Modifica alla Macro

Postdi Anthony47 » 27/05/09 01:36

Penso che debba cambiare questa
Estra = Estra + Application.WorksheetFunction.CountIf _
(Range("Q2:Y2"), Range("A1").Offset(I - 1, J - 1 + K))

in questa:
Codice: Seleziona tutto
Estra = Estra + Application.WorksheetFunction.CountIf _
        (Range("N3:R3"), Range("A1").Offset(I - 1, J - 1 + K))


Ciao.
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Re: Excel Modifica alla Macro

Postdi Statix » 27/05/09 08:06

Ciao Anthony
questa modifica l''avevo già fatto ,era scontata, la macro non funziona bene,va un po a casaccio,
ho provato a modificare cosi,sembra funzionare bene,ma in realtà mi salta delle combinazioni
Codice: Seleziona tutto
Sub TutteB()
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
ColoInd = 3
For J = 4 To 53 Step 10 'D to BA
For I = 8 To LastR
Estra = 0: K = 0: FiCol = Range("A1").Offset(I - 1, J - 1 + K).Address
For K = 0 To 4  'Scan una riga di estraz '<<<<<<Modificata
Range("A1").Offset(I - 1, J - 1 + K).Select
If Application.WorksheetFunction.CountIf(Range(Range(FiCol), Range("A1").Offset(I - 1, J - 1 + K)), _
       Range("A1").Offset(I - 1, J - 1 + K).Value) < 2 Then
Estra = Estra + Application.WorksheetFunction.CountIf _
        (Range("N3:R3"), Range("A1").Offset(I - 1, J - 1 + K))'<<<<<modificata
End If
Next K
If Estra >= 2 Then
For CI = 0 To 9 'in riga estrazioni
For CJ = 0 To 4 'in riga estratti '<<<<<Modificata
If Cells(I, J + CJ) = Cells(2 + 1, 12 + CI) Then  '<<<< modificata
'Cells(I, J + CJ).Interior.ColorIndex = Cells(2 + 1, 17 + CI).Interior.ColorIndex
Cells(I, J + CJ).Interior.ColorIndex = ColoInd
End If
Next CJ
Next CI
GoTo NRuota
End If
Next I
NRuota:
ColoInd = ColoInd + 1
Next J
End Sub
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: Excel Modifica alla Macro

Postdi Anthony47 » 28/05/09 14:31

Ero partito dalla cosa piu' semplice per me.. :D
Io sapevo che ogni blocco di informazioni era largo 10 colonne (D9:M9; N9:W9; X9:AG9; etc), mentre la macro da te modificata lavora su 5 colonne (tue righe " For K = 0 To 4 'Scan una riga di estraz '<<<<<<Modificata"); questo penso sia un errore di adattamento della macro, legato al fatto che nella vecchia macro sia il blocco "estratti" (in Q2:Y2) che i vari blocchi "estrazioni" erano largi 10.

Ripartendo dalla macro originale, la nuova versione dovrebbe essere questa:
Codice: Seleziona tutto
    Sub pppter()
    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
    ColoInd = 3
    For J = 4 To 53 Step 10 'D to BA
    For I = 8 To LastR
    Estra = 0: K = 0: FiCol = Range("A1").Offset(I - 1, J - 1 + K).Address
    For K = 0 To 9  'Scan una riga di estraz
    Range("A1").Offset(I - 1, J - 1 + K).Select
    If Application.WorksheetFunction.CountIf(Range(Range(FiCol), Range("A1").Offset(I - 1, J - 1 + K)), _
           Range("A1").Offset(I - 1, J - 1 + K).Value) < 2 Then
    Estra = Estra + Application.WorksheetFunction.CountIf _
            (Range("N3:R3"),  Range("A1").Offset(I - 1, J - 1 + K))     '<><><><>  MODIF
    End If
    Next K
    If Estra >= 2 Then
    For CI = 0 To 4 'in riga estrazioni      '<><><><>  MODIF
    For CJ = 0 To 9 'in riga estratti
    If Cells(I, J + CJ) = Cells(2, 14 + CI) Then      '<><><><>  MODIF (14=N)
    'Cells(I, J + CJ).Interior.ColorIndex = Cells(2 + 1, 17 + CI).Interior.ColorIndex
    Cells(I, J + CJ).Interior.ColorIndex = ColoInd
    End If
    Next CJ
    Next CI
    GoTo NRuota
    End If
    Next I
    NRuota:
    ColoInd = ColoInd + 1
    Next J
    End Sub


Spero che funga!
Avatar utente
Anthony47
Moderatore
 
Post: 19196
Iscritto il: 21/03/06 16:03
Località: Ivrea

Precedente

Torna a Applicazioni Office Windows


Topic correlati a "Excel Modifica alla Macro":


Chi c’è in linea

Visitano il forum: systemcrack e 36 ospiti