Condividi:        

tabellone analitico Lotto

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

tabellone analitico Lotto

Postdi Statix » 11/06/11 23:25

Ciao,ho questa macro che mi incolonna i 90 numeri nelle 5 posizioni,
vorrei se possibile modificarla in modo che mi dia una tabella in questo modo,
il range dell'estrazioni
C5:G300
Immagine

Codice: Seleziona tutto
Sub collax2()
CelleFree = "J1"    '<< Colonna in cui sara' scritto il report
TuArea = "B1:F300" '<< Area con i dati
'
Compen = Range(TuArea).Column: MaxR = 0
Application.ScreenUpdating = False
For Each Cella In Range(TuArea)
aaa = Cella.Row
Set CFormArea = Range(TuArea).Offset(Cella.Row).Resize(Range(TuArea).Rows.Count - Cella.Row + 1)
If Application.WorksheetFunction.CountIf(CFormArea, Cella.Value) = 0 Then _
   Range(CelleFree).Offset(Rows.Count - 1, Cella.Column - Compen).End(xlUp).Offset(1, 0) = Cella.Value
If Range(CelleFree).Offset(Rows.Count - 1, Cella.Column - Compen).End(xlUp).Offset(1, 0).Row > MaxR Then _
   MaxR = Range(CelleFree).Offset(Rows.Count - 1, Cella.Column - Compen).End(xlUp).Offset(1, 0).Row
Next Cella
'>>>AGGIUNTO
For Each Cella In Range(CelleFree).Resize(1, Range(TuArea).Columns.Count)
Range(Cella, Cells(Rows.Count, Cella.Column).End(xlUp)).Select
Selection.Cut Destination:=Cella.Offset(MaxR - Selection.Rows.Count, 0)
Next Cella
Range(CelleFree).Select: Application.ScreenUpdating = True
End Sub
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Sponsor
 

Re: tabellone analitico Lotto

Postdi Avatar3 » 11/06/11 23:30

Scusami
io vedo dei numeri a caso e senza una logica
potresti spiegare meglio?
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: tabellone analitico Lotto

Postdi Statix » 11/06/11 23:44

Ok cerco di spiegarti,
allego foto,
come vedi ci sono delle estrazioni,con la macro postata
mi ricava i 90 numeri per posizione cioè i numeri per colonna ,
partendo dal basso verso l'alto,cioè dall'ultima estrazione inserita.
la macro salendo verso l'alto mi toglie i numeri già usciti
precedentemente,in questo caso sono incolonnatti una sopra l'altro,
mentre vorrei che fosse come la foto precedente.
Immagine

ecco come dovrebbe essere,
l'ultima estrazione inserita ,mi sono dimenticato di eliminare i numeri nella tabella,
esempio il 45 precedente va azzerato cos' per gli altri 4 numeri

Immagine
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: tabellone analitico Lotto

Postdi Avatar3 » 12/06/11 00:46

Beh credo che la macro da te postata avendo il controllo offset tolga i "buchi" che tu vorresti
pertanto prima di capire e modificare una macro che non conosco preferisco lavorare sulle mie
questa che ti propongo è la stessa dell'altro topic e adattata a questa nuova esigenza
sta a te inserire le coordinate alla nuova distribuzione dati (prima avevamo colonna c = 3 e G = 7 ora se hai B e F dovrai mettere 2 e 6 nel ciclo for.. next delle colonne CC e CC1
Codice: Seleziona tutto
Sub EliminaNumUsciti()
UR = Range("C" & Rows.Count).End(xlUp).Row

Dim VN As Integer
Dim VN1 As Integer
For RR = UR To 4 Step -1
For CC = 3 To 7
    If Cells(RR, CC).Value <> "..." Then
        VN = Cells(RR, CC).Value
        For RR1 = RR - 1 To 3 Step -1
            For CC1 = 3 To 7
                If Cells(RR1, CC1).Value <> "..." Then
                    VN1 = Cells(RR1, CC1).Value
                    If VN = VN1 Then Cells(RR1, CC1).Value = "..."
                End If
            Next CC1
    Next RR1
End If
Next CC
Next RR
End Sub


P.s. l'uica cosa che non capivo era la colonna a destra (blu) della prima figura :roll:
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: tabellone analitico Lotto

Postdi Statix » 12/06/11 09:48

Ciao Avatar3,
la macro va bene,ma c'è un problema,anzi 2
1)la macro agisce direttamente sulla tabella delle estrazioni,
invece dovrebbe ricrearne una nuova eventualmente in range R4:V300,senza intaccare le estrazioni,range C4:G300 queste contengono formule che io uso per cambiare ruota ed estrazione
2) eliminare le righe vuote, cioè le righe dove ci sono solo ... ... ... ... ...
il top sarebbe anche quello di affiancarne il ritardo,
partendo dall'ultima riga ,si ha valore 0
poi ogni riga precedente aumenta di 1
vedi foto
Immagine
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: tabellone analitico Lotto

Postdi Avatar3 » 12/06/11 10:41

Dovrebbe andare
Codice: Seleziona tutto
Sub EliminaNumUsciti()
Application.ScreenUpdating = False
Application.Calculation = xlManual
Columns("B:F").Copy Destination:=Columns("R:R")
UR = Range("R" & Rows.Count).End(xlUp).Row
For RR = UR To 1 Step -1
Range("Q" & RR).Value = UR - RR
Next RR
Dim VN As Integer
Dim VN1 As Integer
For RR = UR To 2 Step -1
For CC = 18 To 22
    If Cells(RR, CC).Value <> "..." Then
        VN = Cells(RR, CC).Value
        For RR1 = RR - 1 To 1 Step -1
            For CC1 = 18 To 22
                If Cells(RR1, CC1).Value <> "..." Then
                    VN1 = Cells(RR1, CC1).Value
                    If VN = VN1 Then Cells(RR1, CC1).Value = "..."
                End If
            Next CC1
    Next RR1
End If
Next CC
Next RR

For RR = UR To 1 Step -1
ContaV = 0
For CC = 18 To 22
 If Cells(RR, CC).Value = "..." Then ContaV = ContaV + 1
Next CC
If ContaV = 5 Then Range("Q" & RR & ":V" & RR).Delete Shift:=xlUp
Next RR
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
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: tabellone analitico Lotto

Postdi Statix » 12/06/11 10:52

Provata,non va,
c'è un problema di formattazione dei dati in più
i ritardi sono ripetuti e non elimina del tutto le righe vuote cioè la riga con tutti i puntini
Immagine
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: tabellone analitico Lotto

Postdi Statix » 12/06/11 10:59

Ok trovato il problema,era una questione di range,
c'è un altra cosa se è possibile,allineare la tabella in basso ,
cioè nella stessa riga dell'ultima estrazione a salire,
come faceva la macro precedente.
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: tabellone analitico Lotto

Postdi Avatar3 » 12/06/11 11:18

Quindi il problema del tuo penultimo post è risolto? :roll:

Se si
questa modifica allinea la tabella all'ultima estrazione
Codice: Seleziona tutto
Sub EliminaNumUsciti()
Application.ScreenUpdating = False
Application.Calculation = xlManual
Columns("B:F").Copy Destination:=Columns("R:R")
UR = Range("R" & Rows.Count).End(xlUp).Row
For RR = UR To 1 Step -1
Range("Q" & RR).Value = UR - RR
Next RR
Dim VN As Integer
Dim VN1 As Integer
For RR = UR To 2 Step -1
For CC = 18 To 22
    If Cells(RR, CC).Value <> "..." Then
        VN = Cells(RR, CC).Value
        For RR1 = RR - 1 To 1 Step -1
            For CC1 = 18 To 22
                If Cells(RR1, CC1).Value <> "..." Then
                    VN1 = Cells(RR1, CC1).Value
                    If VN = VN1 Then Cells(RR1, CC1).Value = "..."
                End If
            Next CC1
    Next RR1
End If
Next CC
Next RR

For RR = UR To 1 Step -1
ContaV = 0
For CC = 18 To 22
 If Cells(RR, CC).Value = "..." Then ContaV = ContaV + 1
Next CC
If ContaV = 5 Then Range("Q" & RR & ":V" & RR).Delete Shift:=xlUp
Next RR
UR2 = Range("R" & Rows.Count).End(xlUp).Row
VR = 1 + UR - UR2
Range("Q1:V" & UR2).Cut Destination:=Range("Q" & VR & ":V" & UR)
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
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: tabellone analitico Lotto

Postdi Statix » 12/06/11 11:29

Ok, è perfetta,
ho fatto alcuni aggiustamenti dei range,
adesso è proprio come volevo ,cioè la prima foto postata.
grazie.
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: tabellone analitico Lotto

Postdi Avatar3 » 12/06/11 11:35

Allora ok l'ho perfezionata, è più veloce perché faccio eseguire il conteggio delle righe vuote durante il processo e non dopo, infatti vedrai che in questa macro ci non meno righe (due cicli for... next in meno)
Codice: Seleziona tutto
Sub EliminaNumUsciti2()
Application.ScreenUpdating = False
Application.Calculation = xlManual
Columns("B:F").Copy Destination:=Columns("R:R")
UR = Range("R" & Rows.Count).End(xlUp).Row
For RR = UR To 1 Step -1
Range("Q" & RR).Value = UR - RR
Next RR
Dim VN As Integer
Dim VN1 As Integer
For RR = UR To 2 Step -1
For CC = 18 To 22
    If Cells(RR, CC).Value <> "..." Then
        VN = Cells(RR, CC).Value
        For RR1 = RR - 1 To 1 Step -1
        ContaV = 0
            For CC1 = 18 To 22
                If Cells(RR1, CC1).Value <> "..." Then
                    VN1 = Cells(RR1, CC1).Value
                    If VN = VN1 Then
                        Cells(RR1, CC1).Value = "..."
                        ContaV = ContaV + 1
                    End If
                Else
                ContaV = ContaV + 1
                End If
            Next CC1
        If ContaV = 5 Then Range("Q" & RR1 & ":V" & RR1).Delete Shift:=xlUp
    Next RR1
End If
Next CC
Next RR

UR2 = Range("R" & Rows.Count).End(xlUp).Row
VR = 1 + UR - UR2
Range("Q1:V" & UR2).Cut Destination:=Range("Q" & VR & ":V" & UR)
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
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: tabellone analitico Lotto

Postdi Statix » 12/06/11 11:51

Non so dirti,ma sembra che la precedente vada meglio.
;) ;) ciao e grazie.
Ti auguro una buona domenica.
Statix
Windows 10,
Office 2013,
Statix
Utente Senior
 
Post: 1287
Iscritto il: 12/05/06 21:55
Località: Provincia di Caserta

Re: tabellone analitico Lotto

Postdi Avatar3 » 12/06/11 12:02

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


Torna a Applicazioni Office Windows


Topic correlati a "tabellone analitico Lotto":


Chi c’è in linea

Visitano il forum: Nessuno e 38 ospiti