Excel incolonnare dati

[Statix]

Ciao a tutti avrei bisogno di un aiuto per risolvere questo problema,
ho creato un tabellone analitico con la formattazione condizionale,vedi foto,
di fianco vorrei far in modo di incolonnare gli estratti senza le celle ombreggiate,vedi foto
da considerare che le estrazioni dell'analitico le sposto avanti e indietro con tasto di selezione,
cioè mi sposto con un estrazione alla volta per vedere l'andamento estrattivo dei numeri.

[Statix]

ecco una foto di un vecchio programma in Qbasic realizzato nel 90,
adesso lo vorrei realizzare in excel, gli estratti vengono incolonnati uno sopra l'altro evidenziando la nuova estrazione lampeggiando in rosso, con sotto le statistiche,ritardi d'uscita,presenze della colonna,estratti per colonna.

[ricky53]

Ciao statix,
prova con questa macro

Codice: Seleziona tutto

' Vengono copiati i dati se il colore del carattere delle cella analizzata cells (J, I)  è "Automatico" o  "Nero" ("1")
' Adatta secondo le tue esigenze ---->> colore del carattere che hai impostato
Sub Copia_Dati()
    UR = Range(Cells(1, 3).End(xlDown).Address).Row
    For I = 3 To 7
        K = UR
        For J = UR To 1 Step -1
            If Cells(J, I) <> "" And (Cells(J, I).Font.ColorIndex = xlAutomatic Or Cells(J, I).Font.ColorIndex = 1) Then
                Cells(K, I + 7) = Cells(J, I)
                K = K - 1
            End If
        Next J
    Next I
End Sub


Ciao da Ricky53

[ricky53]

Ciao,
non l'ho scritto nel mio precedente intervento, ritenendolo scontato (ma era meglio spiegarlo).

Ho preso come riferimenti di colonne quello che hai inviato tu nell'immagine:

a. i dati sono nell'intervallo "C-G" e vengono copiati in "J-N"

b. le righe delle colonne di partenza sono uguali per tutte le 5 colonne "C-G"

c. i dati devono essere copiati (quando sono soddisfatte le condizioni del "colore carattere" che ti ho scritto) a partire dal basso salendo verso l'alto nelle colonne "J-N"

Ciao da Ricky53

[Statix]

Ciao Ricky53
ho provato la macro, non funziona con gli estratti in quanto alle estrazioni è applicata la formattazione condizionale,
mentre se li imposto con colore carattere funziona.mi sa tanto che dovrò impostare una nuova strategia per il programma,al momento,test,ho gestito le estrazioni avanti/indietro con cerca.verticale e creato l'analitico con la formattazione condizionale e fin qui tutto ok.

Codice: Seleziona tutto

=CONTA.SE($C2:$G$1000;C1)>0

formato carattere grigio 25%
credo che la difficoltà sta nel gestire l'incolonnamento dei dati ,senza le celle ombreggiate,con avanti/indietro delle estrazioni.
In passato con Qbasic con quatto righe di codice era tutto più semplice.

[Statix]

Vi allego il listato,così ci date un occhiata per vedere se è possibile fare una parte di reverse in Excel(macro)

Codice: Seleziona tutto

SUB comando
OPEN "c:\lotto\archivio.arc" FOR BINARY AS #1

WIDTH 80, 43
CLS

riga% = 1: colonna% = 1
colore% = 10
lunghezza% = 78: larghezza% = 41
CALL RETTANGOLO
                                             
COLOR , 7
LOCATE 2, 2: PRINT "                                                                            "
LOCATE 2, 17: COLOR 1, 7: PRINT "ANALISI FORMULE ESTRATTI o NUMERI SPECIFICI"
CHIAMAR: CFG = 0
CALL CHIAMARUOTA
IF PARAMET%(11) > 0 THEN GOTO CHIAMAR:
FOR a = 1 TO 10
IF PARAMET%(a) > 0 THEN CFG = CFG + 1: numeroruota = a

NEXT: IF CFG > 1 THEN GOTO CHIAMAR:

riga% = 22: colonna% = 22
colore% = 1
lunghezza% = 40: larghezza% = 4
CALL RETTANGOLO
estra: a$ = "": COLOR 5
LOCATE 23, 25: PRINT "Da quale Estrazione         "; : INPUT a$
daquale = VAL(a$): IF daquale < 2 OR daquale > Co THEN GOTO estra


seleznum: a$ = ""
riga% = 24: colonna% = 24
colore% = 4
lunghezza% = 40: larghezza% = 4
CALL RETTANGOLO
LOCATE 25, 26: PRINT "(N) Num Vari   (T) Tutti i 90"; : a$ = INPUT$(1)
inputta:
a$ = UCASE$(a$): iin = 0
IF a$ = "N" THEN CALL inserform: GOTO appresso
IF a$ = "T" THEN iin = 90: FOR a = 1 TO 90: in%(a) = a: NEXT: GOTO appresso
GOTO inputta


appresso:
riga% = 1: colonna% = 1
colore% = 10
lunghezza% = 78: larghezza% = 41
CALL RETTANGOLO
                                           
COLOR , 7
LOCATE 2, 2: PRINT "                                                                            "
LOCATE 2, 17: COLOR 1, 7: PRINT "ANALISI FORMULE ESTRATTI o NUMERI SPECIFICI"

'PRINT IIN
COLOR 0, 4
LOCATE 3, 53: PRINT "  1 "; "  2 "; "  3 "; "  4 "; "  5  "
COLOR 1, 0
FOR a = 1 TO 32
LOCATE , 53:
FOR B = 1 TO 6
PRINT CHR$(179); "   ";
NEXT B: PRINT
NEXT a:

COLOR 8
LOCATE 4
FOR a = 32 TO 1 STEP -1
LOCATE , 76
PRINT USING "##"; a
NEXT



tt% = 90:  ' tt% VARIABILE DA AZZERARE PER SCROLL 90 SU ESTRAZIONI
dataattuale = daquale

leg: ' legge la data della estrazione attuale in esame
tt% = 90
FOR t% = 1 TO 90: posizi%(t%) = 0: ritar%(t%) = 0: NEXT
numerorecord = dataattuale
CALL leggedata: ' data della estrazione in EVIDENZA
 CALL leggeruotaextrax
FOR a = 1 TO 5: estrazione%(a) = scomp%(a, numeroruota): NEXT
' numneri della estrazione in esame
daquale = dataattuale - 1: ' daquale viene scalato mentre dataattuale e' estr in esame

legge:
IF tt% = 0 THEN GOTO escelegge: ' numeri tutti individuati
IF daquale < 1 THEN GOTO escelegge
numerorecord = daquale: CALL leggeruotaextrax
'LOCATE 10, 10: PRINT numerorecord
FOR t% = 1 TO 5: numeri%(t%) = scomp%(t%, numeroruota): NEXT
IF numeri%(1) = 91 OR numeri%(1) = 0 THEN GOTO dec: 'salta il 91
FOR t% = 1 TO 5
n% = numeri%(t%)
IF posizi%(n%) = 0 THEN posizi%(n%) = t%: ritar%(n%) = (dataattuale - daquale) - 1: tt% = tt% - 1
NEXT t%
dec:
daquale = daquale - 1: GOTO legge




escelegge:

LOCATE 4, 3: COLOR 9, 0
PRINT ruota$(numeroruota);
COLOR 6: SOUND 500, .5
PRINT " Est ";
COLOR 9
PRINT dataattuale; : COLOR 6: PRINT " del ";
COLOR 9: PRINT dataa$

scelta:
''''' qui incolonna numeri cioe' calcola quanti per colonna e quali
FOR t% = 0 TO 5: posto%(t%) = 0: NEXT
FOR t% = 1 TO iin
p% = posizi%(in%(t%))
posto%(p%) = posto%(p%) + 1: numposto%(posto%(p%), p%) = in%(t%):
IF posto%(p) > maggiore THEN maggiore = posto%(p)
NEXT t%

'calcolo la formula attuale tra l' estrazione e i numeri in colonna
FOR t% = 1 TO 5: formula%(t%) = 0: NEXT

FOR t% = 1 TO 5
FOR tu% = 1 TO posto%(t%)
FOR ty% = 1 TO 5
IF numposto%(tu%, t%) = estrazione%(ty%) THEN formula%(t%) = formula%(t%) + 1
NEXT: NEXT: NEXT
'-------
' ordina secondo il ritardo scambiando i posti in numposto secondo il ritardo
' modificando solo l' ordine dei numeri nel buffer NUMPOSTO%(POSTO%(),5)
FOR t% = 1 TO 5:
IF posto%(t%) = 0 THEN GOTO saltalozero
FOR ty% = 1 TO posto%(t%)
numm% = numposto%(ty%, t%)
rior(ty%) = ritar%(numm%): m3(ty%) = numm%
NEXT: lt = posto%(t%): es = lt: CALL sort
FOR ty% = 1 TO posto%(t%): numposto%(ty%, t%) = m3(ty%): NEXT
saltalozero:
NEXT

'----
' pulisce le colonne video
rig = 35
COLOR 12

FOR t% = 1 TO 5
rig = 35
iinriga:
FOR k = 32 TO 1 STEP -1
LOCATE rig, 50 + (4 * t%)
PRINT "   "
rig = rig - 1
NEXT k
NEXT t%

'--
' li incolonna a video con lampeggiamento
rig = 35
COLOR 3
FOR t% = 1 TO 5
COLOR 3
rig = 35
inriga:
FOR k = posto%(t%) TO 1 STEP -1
LOCATE rig, 50 + (4 * t%)
flagcolor = 0
FOR ty% = 1 TO 5
IF numposto%(k, t%) = estrazione%(ty%) THEN flagcolor = 1:
NEXT: IF flagcolor = 1 THEN COLOR 28 ELSE COLOR 3
PRINT USING "###"; numposto%(k, t%)
rig = rig - 1
NEXT k
NEXT t%

COLOR 13
LOCATE 37, 50: PRINT "Fo"
LOCATE 37, 53:
FOR t% = 1 TO 5
PRINT USING "####"; formula%(t%); : NEXT: PRINT



COLOR 14
LOCATE 38, 50: PRINT "Pr":
LOCATE 38, 53
COLOR 14
FOR t% = 1 TO 5
PRINT USING "####"; posto%(t%); : NEXT

COLOR 12
LOCATE 39, 50: PRINT "Es": LOCATE 39, 53
COLOR 12
FOR t% = 1 TO 5
PRINT USING "####"; estrazione%(t%); : NEXT: PRINT

COLOR 13
LOCATE 40, 50: PRINT "Ri": LOCATE 40, 53
COLOR 13
FOR t% = 1 TO 5

PRINT USING "####"; ritar%(estrazione%(t%)); : NEXT: PRINT






COLOR 14
LOCATE 40, 2: PRINT "  A   Avanti   I   Indietro   ESC   Esce"
COLOR 4
a$ = INPUT$(1): a$ = UCASE$(a$)
IF a$ = "A" AND dataattuale <= Co THEN dataattuale = dataattuale + 1: GOTO leg
IF a$ = "A" AND dataattuale = Co + 1 THEN GOTO leg
IF a$ = "I" AND dataattuale > 3 THEN dataattuale = dataattuale - 1: GOTO leg
IF a$ = "I" AND dataattuale = 2 THEN GOTO leg
IF a$ = CHR$(27) THEN CLOSE #1: EXIT SUB
GOTO scelta


END SUB

[ricky53]

Ciao,
con il VBa non è che siano molte.
E' necessario conoscere esattamente come formatti la cella e poi la si applica alla macro che ti ho proposto al posto di "Font.ColorIndex".
Invia i dati che utilizzi per la formattazione condizionale.

Ciao da Ricky53

[Statix]

ciao Ricky53
le celle sono formato generale
per la formattazione condizionale dei dati uso solo questa formula

Codice: Seleziona tutto

=CONTA.SE($C2:$G$1000;C1)>0

formato carattere colore grigio 25%

[Anthony47]

Statix, puoi per favore controllare la formula della formattazione condizionale? Secondo me e' incongruente...

Ciao.

[Statix]

Ciao Anthony47,
ho riprovato la formula è funziona benissimo,questa è una formula che mi hai dato tempo fa,
perche dici è incongruente?

[Anthony47]

=CONTA.SE($C2:$G$1000;C1)>0

E' incongruente perche' se applicata al range C2:G1000 formatta in grigio tutte le celle oltre la riga 2; d' altra parte e' ovvio che ogni Cx (vale per qualsiasi colonna C:G, con X>1) compare almeno 1 volta nella conta (quindi >0).
Dove sbaglio?

[Statix]

Ciao Ricky
la macro non va, mi da tutti i numeri compresi quelli formattati.

[ricky53]

Ciao,
la formula che utilizzi nella formattazione condizionale è proprio quella che hai scritto, ossia:

ciao Ricky53
le celle sono formato generale
per la formattazione condizionale dei dati uso solo questa formula

Codice: Seleziona tutto
=CONTA.SE($C2:$G$1000;C1)>0
formato carattere colore grigio 25%

Quindi in "C1" hai scritto la formula:
=CONTA.SE($C2:$G$1000;C1)>0

Confermi ???

Adesso chiudo.
Ci sentiamo domani.

Ciao da Ricky53

[Statix]

Ciao ricky
Nel Range C1:G1000 ho gli estratti
la formula

Codice: Seleziona tutto

=CONTA.SE($C2:$G$1000;C1)>0

è inserita nella formattazione condizionale.

[Anthony47]

Ahhhh... adesso NOTO che e' $C2:$G$1000 e non $C$2 come l' avevo letta fino ad adesso!

Mi devo scollegare anche io, magari dopo...

Ciao.

[Anthony47]

Forse questa:

Codice: Seleziona tutto

Sub collax()
CelleFree = "J1"    '<< Colonna in cui sara' scritto il report
TuArea = "C1:G300" '<< Area con i dati
'
Compen = Range(TuArea).Column
Application.ScreenUpdating = False
For Each Cella In Range(TuArea)
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
Next Cella
Application.ScreenUpdating = False
End Sub

Scrive i dati dalla colonna impostata (J, nell' esempio) verso il basso; sono cioe' stalattiti invece che stalagmiti... Se le vuoi al contrario si puo' fare, sara' solo un po' piu' lento.

Ciao.

[Statix]

Ciao Anthony
ho visto che la macro funziona perfettamente,quindi non c'è neanche bisogno della formattazione condizionale,
i dati mi servirebbero allineati dal basso ,ultima estrazione,
per l'estrazioni posso anche invertirle dal basso in alto,se ti è più comodo per velocizzare la macro.

[Statix]

Ho quasi finito,mi manca solo l'allineamento dei dati ,andrebbe bene anche dall'alto cioè i numeri che stanno in tabella
capolgendoli dall'ultimo al primo
1)52-77-59-58-80
2)63-24-49-60-35
3)etc.etc.

[Anthony47]

Mi pare che questa generi stalagmiti invece di stalattiti ...

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

Ciao.

[Statix]

Ciao Anthony
ho provato la nuova macro,tutto ok,
ho avuto qualche difficoltà a visualizzare i dati in un altro foglio dove ho la griglia di visualizzazione, in quanto ad ogni avanti/indietro di una estrazione ,si perdevano i riferimenti,ho risolto con "indiretto".
con la prima macro questo non accadeva.
comunque va bene lo stesso,grazie di tutto.