Condividi:        

CALCOLO

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: CALCOLO

Postdi Avatar3 » 17/05/11 20:29

Per colorare le celle in viola ho modificato la macro1 (Ritardi) che richiama la seconda macro a ritroso per colorare le celle in giallo
Corretta la colorazione al di sopra di 10 ritardi ma l'esempio del 56 riportato da te non rispecchia nessuna logica
l'unica cosa che posso pensare è che hai un numero "sporco" controlla che non ci siano spazi (eventualmente ridigita il numero)
quindi ti invio le macro corrette
Codice: Seleziona tutto
Sub Ritardi()
Foglio = "Foglio1"
UR = Worksheets(Foglio).Range("C" & Rows.Count).End(xlUp).Row
Worksheets(Foglio).Range("N2:R" & UR).ClearContents
Worksheets(Foglio).Columns("C:G").Interior.ColorIndex = xlNone
For RR = 3 To UR
    For CC = 8 To 12
    Conta = 1
        If Worksheets(Foglio).Cells(RR, CC) <> ".." Then
            Num = Worksheets(Foglio).Cells(RR, CC).Value
            For RRC = RR - 1 To RR
            For CCC = 3 To 7
            If Num = Worksheets(Foglio).Cells(RRC, CCC).Value Then Worksheets(Foglio).Cells(RRC, CCC).Interior.ColorIndex = 38
            Next CCC
            Next RRC
            For RR2 = RR + 1 To UR
                For CC2 = 3 To 7
                    If Num = Worksheets(Foglio).Cells(RR2, CC2).Value Then
                        UC = Worksheets(Foglio).Range("IV" & RR).End(xlToLeft).Column + 1
                        If UC < 14 Then UC = 14
                        Worksheets(Foglio).Cells(RR, UC).Value = Conta
                        GoTo Continua
                    End If
                Next CC2
                Conta = Conta + 1
            Next RR2
        End If
Continua:
    Next CC
Next RR
Call ColorBack
End Sub


Sub ColorBack()
Foglio = "Foglio1"
UR = Worksheets(Foglio).Range("C" & Rows.Count).End(xlUp).Row
 '    Worksheets(Foglio).Columns("C:G").Interior.ColorIndex = xlNone
For RR = UR To 3 Step -1
    For CC = 8 To 12
    Conta = 1
    ContaR = 0
        If Worksheets(Foglio).Cells(RR, CC) <> ".." Then
            Num = Worksheets(Foglio).Cells(RR, CC).Value
            For RR2 = RR - 1 To 2 Step -1
            ContaR = ContaR + 1
            If ContaR > 10 Then GoTo SaltaC
                For CC2 = 3 To 7
                    If Num = Worksheets(Foglio).Cells(RR2, CC2).Value Then
                        Conta = Conta + 1
                        If Conta = 2 Then
                            MRR2 = RR2
                            MCC2 = CC2
                        End If
                        If Conta = 3 Then
                            Worksheets(Foglio).Cells(MRR2, MCC2).Interior.ColorIndex = 6
                            Worksheets(Foglio).Cells(RR2, CC2).Interior.ColorIndex = 6
                            GoTo SaltaC
                        End If
                    End If
                Next CC2
            Next RR2
        End If
    Next CC
SaltaC:
Next RR
End Sub


Chiaramente devi avviare la macro "Ritardi"

ciao
Per il funzionamento delle macro si deve impostare la protezione a Bassa o Media.
Menu Strumenti -> Macro -> Protezione...
Avatar utente
Avatar3
Utente Senior
 
Post: 569
Iscritto il: 04/04/11 09:04

Sponsor
 

Re: CALCOLO

Postdi Lucio Peruggini » 17/05/11 22:40

Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: CALCOLO

Postdi Avatar3 » 17/05/11 22:54

Ho commentato le righe che non servono
ora le righe doppie rimangono con il colore originale (le righe commentate le puoi eliminare)

Codice: Seleziona tutto
Sub Ritardi()
Foglio = "Foglio1"
UR = Worksheets(Foglio).Range("C" & Rows.Count).End(xlUp).Row
Worksheets(Foglio).Range("N2:R" & UR).ClearContents
Worksheets(Foglio).Columns("C:G").Interior.ColorIndex = xlNone
For RR = 3 To UR
    For CC = 8 To 12
    Conta = 1
        If Worksheets(Foglio).Cells(RR, CC) <> ".." Then
            Num = Worksheets(Foglio).Cells(RR, CC).Value
            For RRC = RR - 1 To RR
            For CCC = 3 To 7
            If Num = Worksheets(Foglio).Cells(RRC, CCC).Value Then Worksheets(Foglio).Cells(RRC, CCC).Interior.ColorIndex = 38
            Next CCC
            Next RRC
            For RR2 = RR + 1 To UR
                For CC2 = 3 To 7
                    If Num = Worksheets(Foglio).Cells(RR2, CC2).Value Then
                        UC = Worksheets(Foglio).Range("IV" & RR).End(xlToLeft).Column + 1
                        If UC < 14 Then UC = 14
                        Worksheets(Foglio).Cells(RR, UC).Value = Conta
                        GoTo Continua
                    End If
                Next CC2
                Conta = Conta + 1
            Next RR2
        End If
Continua:
    Next CC
Next RR
Call ColorBack
End Sub


Sub ColorBack()
Foglio = "Foglio1"
UR = Worksheets(Foglio).Range("C" & Rows.Count).End(xlUp).Row
 '    Worksheets(Foglio).Columns("C:G").Interior.ColorIndex = xlNone
For RR = UR To 3 Step -1
    For CC = 8 To 12
    Conta = 1
    ContaR = 0
        If Worksheets(Foglio).Cells(RR, CC) <> ".." Then
            Num = Worksheets(Foglio).Cells(RR, CC).Value
            For RR2 = RR - 1 To 2 Step -1
            ContaR = ContaR + 1
            If ContaR > 10 Then GoTo SaltaC
                For CC2 = 3 To 7
                    If Num = Worksheets(Foglio).Cells(RR2, CC2).Value Then
                        Conta = Conta + 1
                        'If Conta = 2 Then
                         '   MRR2 = RR2
                         '   MCC2 = CC2
                        'End If
                        If Conta = 3 Then
                          '  Worksheets(Foglio).Cells(MRR2, MCC2).Interior.ColorIndex = 6
                            Worksheets(Foglio).Cells(RR2, CC2).Interior.ColorIndex = 6
                            GoTo SaltaC
                        End If
                    End If
                Next CC2
            Next RR2
        End If
    Next CC
SaltaC:
Next RR
End Sub


Ciao
Per il funzionamento delle macro si deve impostare la protezione a Bassa o Media.
Menu Strumenti -> Macro -> Protezione...
Avatar utente
Avatar3
Utente Senior
 
Post: 569
Iscritto il: 04/04/11 09:04

Re: CALCOLO

Postdi Lucio Peruggini » 17/05/11 23:27

OK E' PERFETTO, MILLE GRAZZZZIE

Buona nottata
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: CALCOLO

Postdi Avatar3 » 17/05/11 23:32

Notte! :)
Per il funzionamento delle macro si deve impostare la protezione a Bassa o Media.
Menu Strumenti -> Macro -> Protezione...
Avatar utente
Avatar3
Utente Senior
 
Post: 569
Iscritto il: 04/04/11 09:04

Re: CALCOLO

Postdi Lucio Peruggini » 18/05/11 22:25

Ciao Avatar, gentilmente e quando puoi; piccola modifica alla prima macro che mi hai fatto.
Nelle foto gli esempi.

http://screenshotuploader.com/s/WhoY8SZmx8y

http://screenshotuploader.com/s/TVycFTEolqj

In questo caso la colonna "I" porterà un solo ritardo indipendentemente da quanti numeri vi si trovano nella riga "C:G".


Codice: Seleziona tutto
Sub Colora()
    URD = Worksheets("Archivio con Macro").Range("C" & Rows.Count).End(xlUp).Row
    Worksheets("Archivio con Macro").Range("C1:G" & URD).Interior.ColorIndex = xlNone
    Area = "C1:G" & URD
    For CC = 12 To 26
        ValC = Cells(1, CC).Value
        For Each ValCA In Worksheets("Archivio con Macro").Range(Area)
            If ValC = ValCA Then ValCA.Interior.ColorIndex = 6
        Next
    Next CC
    End Sub


Saluti
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: CALCOLO

Postdi Avatar3 » 18/05/11 22:51

Io non ho nessun file avente quella disposizione dei dati
La macro che colorava le celle si riferiva alla sola colonna C nella quale avevi i numeri separati da un punto come questo esempio
72.12.42.04.33

e non occupavano 5 colonne (da C a G)

In pratica dovrei impostare un foglio simile al tuo
ritengo più opportuno che lo inviassi tu stesso un file (non necessariamente con l'intero archivio)

ciao
Per il funzionamento delle macro si deve impostare la protezione a Bassa o Media.
Menu Strumenti -> Macro -> Protezione...
Avatar utente
Avatar3
Utente Senior
 
Post: 569
Iscritto il: 04/04/11 09:04

Re: CALCOLO

Postdi Lucio Peruggini » 18/05/11 23:07

Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: CALCOLO

Postdi Avatar3 » 18/05/11 23:21

Ehm
Continuo a non capire, nel foglio inviato, oltre a non contenere alcuna macro, non noto alcuna corrispondenza tra i ritardi nella colonna I e i numeri inseriti nella riga 1 da L a X

Ciao
Per il funzionamento delle macro si deve impostare la protezione a Bassa o Media.
Menu Strumenti -> Macro -> Protezione...
Avatar utente
Avatar3
Utente Senior
 
Post: 569
Iscritto il: 04/04/11 09:04

Re: CALCOLO

Postdi Lucio Peruggini » 18/05/11 23:35

http://screenshotuploader.com/s/G0PaQTnpxTO

Hai ragione, stavo lavorando sul foglio e ho cambiato i numeri. In questa foto ho messo altri numeri a caso e manualmente ho messo i ritardi in colonna "I".

Il foglio non ha la macro dentro, pensavo la mettessi tu stesso. La macro è quella inserita nel post; basta solamente mettere dei numeri, qualunque essi siano e, ovviamente in "I" calcolare i ritardi.
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: CALCOLO

Postdi Avatar3 » 19/05/11 00:00

Prova questa macro (ho modificato anche la prima "Colora" per evitare inutili ricerche se non è occupata l'intera riga L1:Z1)

Codice: Seleziona tutto
Sub Colora()
Application.ScreenUpdating = False
Application.Calculation = xlManual
    URD = Worksheets("Archivio con Macro").Range("C" & Rows.Count).End(xlUp).Row
    Worksheets("Archivio con Macro").Range("C1:G" & URD).Interior.ColorIndex = xlNone
    Area = "C1:G" & URD
    For CC = 12 To 26
        ValC = Cells(1, CC).Value
        If ValC = 0 Then Exit Sub
        For Each ValCA In Worksheets("Archivio con Macro").Range(Area)
            If ValC = ValCA Then ValCA.Interior.ColorIndex = 6
        Next
    Next CC
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
    End Sub
Sub RitardiI()
Application.ScreenUpdating = False
Application.Calculation = xlManual
    Worksheets("Archivio con Macro").Columns("I:I").ClearContents
    UR = Worksheets("Archivio con Macro").Range("C" & Rows.Count).End(xlUp).Row
    UC = Worksheets("Archivio con Macro").Range("IV1").End(xlToLeft).Column
    If UC < 12 Then Exit Sub
    MRuota = ""
    For RR = 2 To UR
        Ruota = Worksheets("Archivio con Macro").Range("B" & RR).Value
        If MRuota <> Ruota Then
            Worksheets("Archivio con Macro").Range("I" & RR).Value = 0
            ContaR = 0
            MRuota = Ruota
        Else
            ContaR = ContaR + 1
            For CC = 12 To UC
            For CCE = 3 To 7
            ValC = Worksheets("Archivio con Macro").Cells(1, CC).Value
            If ValC = Worksheets("Archivio con Macro").Cells(RR, CCE).Value Then
                Worksheets("Archivio con Macro").Cells(RR, 9).Value = ContaR
                ContaR = 0
                GoTo SaltaRR
            End If
            Next CCE
            Next CC
        End If
SaltaRR:
    Next RR
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


Ciao
Per il funzionamento delle macro si deve impostare la protezione a Bassa o Media.
Menu Strumenti -> Macro -> Protezione...
Avatar utente
Avatar3
Utente Senior
 
Post: 569
Iscritto il: 04/04/11 09:04

Re: CALCOLO

Postdi Lucio Peruggini » 19/05/11 00:17

Grazie Avatar
Funziona benissimo però il colore mi serviva.
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: CALCOLO

Postdi Avatar3 » 19/05/11 00:32

Ma infatti l'ho lasciata la macro colore
non devi far altro che aggiungere la chiamata alla seconda macro in questa maniera

Codice: Seleziona tutto
Sub Colora()
...
...
...

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Call RitardiI  '<<<<<<<< aggiungi solo questo codice in questo punto della macro "Colora" e poi avviala
    End Sub
Sub RitardiI()
...


Ciao
Per il funzionamento delle macro si deve impostare la protezione a Bassa o Media.
Menu Strumenti -> Macro -> Protezione...
Avatar utente
Avatar3
Utente Senior
 
Post: 569
Iscritto il: 04/04/11 09:04

Re: CALCOLO

Postdi Lucio Peruggini » 19/05/11 00:42

Fammi capire:

Io intendevo farlo contemporaneamente (colore e ritardo).

Se inserisco anche l'altra macro, lavorano insieme)? Scusa ma purtroppo non mastico il VB, abbi pazienza.
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: CALCOLO

Postdi Lucio Peruggini » 19/05/11 00:48

Ho fatto come suggeritomi, ma non ha colorato nulla.
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: CALCOLO

Postdi Avatar3 » 19/05/11 00:52

No
Lavora prima la macro colore e poi si avvia l'altra (Ritardi)
sono due concetti diversi e penso si debba intervenire diversamente
Forse studiando meglio il problema si può pensare ad una sola macro

Ci penserò...

ciao


Edit mentre scrivevo ho letto che non ti funziona la macro allora te la invio completa
e devi far avviare la macro "Colora" (non RitardiI)
Codice: Seleziona tutto
Sub Colora()
Application.ScreenUpdating = False
Application.Calculation = xlManual
    URD = Worksheets("Archivio con Macro").Range("C" & Rows.Count).End(xlUp).Row
    Worksheets("Archivio con Macro").Range("C1:G" & URD).Interior.ColorIndex = xlNone
    Area = "C1:G" & URD
    For CC = 12 To 26
        ValC = Cells(1, CC).Value
        If ValC = 0 Then Exit Sub
        For Each ValCA In Worksheets("Archivio con Macro").Range(Area)
            If ValC = ValCA Then ValCA.Interior.ColorIndex = 6
        Next
    Next CC
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Call RitardiI
    End Sub
Sub RitardiI()
Application.ScreenUpdating = False
Application.Calculation = xlManual
    Worksheets("Archivio con Macro").Columns("I:I").ClearContents
    UR = Worksheets("Archivio con Macro").Range("C" & Rows.Count).End(xlUp).Row
    UC = Worksheets("Archivio con Macro").Range("IV1").End(xlToLeft).Column
    If UC < 12 Then Exit Sub
    MRuota = ""
    For RR = 2 To UR
        Ruota = Worksheets("Archivio con Macro").Range("B" & RR).Value
        If MRuota <> Ruota Then
            Worksheets("Archivio con Macro").Range("I" & RR).Value = 0
            ContaR = 0
            MRuota = Ruota
        Else
            ContaR = ContaR + 1
            For CC = 12 To UC
            For CCE = 3 To 7
            ValC = Worksheets("Archivio con Macro").Cells(1, CC).Value
            If ValC = Worksheets("Archivio con Macro").Cells(RR, CCE).Value Then
                Worksheets("Archivio con Macro").Cells(RR, 9).Value = ContaR
                ContaR = 0
                GoTo SaltaRR
            End If
            Next CCE
            Next CC
        End If
SaltaRR:
    Next RR
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Per il funzionamento delle macro si deve impostare la protezione a Bassa o Media.
Menu Strumenti -> Macro -> Protezione...
Avatar utente
Avatar3
Utente Senior
 
Post: 569
Iscritto il: 04/04/11 09:04

Re: CALCOLO

Postdi Lucio Peruggini » 19/05/11 01:06

Niente da fare!

Facendo partire la macro (colora), mi colora le celle ma non segna i ritardi. Pazienza, terrò la seconda macro con i soli ritardi senza del colore.

Grazie per la disponibilità
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: CALCOLO

Postdi Lucio Peruggini » 19/05/11 01:12

Ho notato che posso farlo in due tempi:
Prima assegno la macro colore, poi l'altra. Grazie

Notte
Lucio P.
Versione Office - 2013
Lucio Peruggini
Utente Senior
 
Post: 896
Iscritto il: 24/01/11 16:23

Re: CALCOLO

Postdi Avatar3 » 19/05/11 01:23

Se utilizzi solo l'ultimo codice inviato che contiene le due macro
noterai che c'è la chiamata alla seconda macro quindi dopo la prima si avvia automaticamente la seconda senza che tu debba fare l'avvio singolo di ogni macro

Forse stai utilizzando ancora codici precedenti

Ciao
Per il funzionamento delle macro si deve impostare la protezione a Bassa o Media.
Menu Strumenti -> Macro -> Protezione...
Avatar utente
Avatar3
Utente Senior
 
Post: 569
Iscritto il: 04/04/11 09:04

Re: CALCOLO

Postdi Avatar3 » 19/05/11 01:39

Nel frattempo ho realizzato quest'altro codice in una unica macro
Prova e fai sapere

Codice: Seleziona tutto
Sub ColoraEContaR()
Application.ScreenUpdating = False
Application.Calculation = xlManual
    URD = Worksheets("Archivio con Macro").Range("C" & Rows.Count).End(xlUp).Row
    Worksheets("Archivio con Macro").Range("C1:G" & URD).Interior.ColorIndex = xlNone
        Worksheets("Archivio con Macro").Columns("I:I").ClearContents
    Area = "C1:G" & URD
    Ruota = ""
    For CC = 12 To 26
        ValC = Cells(1, CC).Value
        If ValC = 0 Then Exit Sub
        For Each ValCa In Worksheets("Archivio con Macro").Range(Area)
            If ValC = ValCa Then
            ValCa.Interior.ColorIndex = 6
            If Worksheets("Archivio con Macro").Cells(ValCa.Row, 9).Value = "" Then Worksheets("Archivio con Macro").Cells(ValCa.Row, 9).Value = 1

            End If
        Next
    Next CC
    For RR = 2 To URD
        Ruota = Worksheets("Archivio con Macro").Range("B" & RR).Value
        If MRuota <> Ruota Then
            Worksheets("Archivio con Macro").Range("I" & RR).Value = 0
            ContaR = 0
            MRuota = Ruota
        Else
            If Worksheets("Archivio con Macro").Range("I" & RR).Value = "" Then
                ContaR = ContaR + 1
            Else
                Worksheets("Archivio con Macro").Range("I" & RR).Value = ContaR + 1
                ContaR = 0
            End If
        End If
    Next RR

Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
    End Sub
Per il funzionamento delle macro si deve impostare la protezione a Bassa o Media.
Menu Strumenti -> Macro -> Protezione...
Avatar utente
Avatar3
Utente Senior
 
Post: 569
Iscritto il: 04/04/11 09:04

PrecedenteProssimo

Torna a Applicazioni Office Windows


Topic correlati a "CALCOLO":


Chi c’è in linea

Visitano il forum: Nessuno e 83 ospiti