album figurine

[wallace&gromit]

ciao a tutti,
con tutte le istruzioni apprese in questo forum speravo di riuscire ad attualizzare e perfezionare un file excel che avevo realizzato 2 anni fa per gestire la raccolta di figurine di mio figlio.
Purtroppo noto con sconforto che non ho fatto grandi passi avanti.
Il file può essere scaricato qui:
https://rapidshare.com/files/2875277357/figurine2012.xls
Ho fallito miseramente in particolare per questi punti:
- vorrei modificare lo stato di una figurina solo con un clic e non dover premere il pulsante
- ho dovuto ricorrere ad un foglio d'appoggio in cui inserisco un numero che rappresenta lo stato delle figurine sul primo foglio, preferirei avere un solo foglio
- vorrei i riassunti in due elenchi (vicino a "cerco" le figurine che mancano; vicino a "offro" le doppie a disposizione) per esempio per inviarli via mail (come passo successivo sarebbe bello importare due elenchi di un altro e ottenere gli scambi possibili).
Infine una curiosità: volevo abbellire i pulsanti creati in precedenza ma non ci sono riuscito. Allora ho creato degli oggetti attribuendo loro una macro. La velocità di esecuzione è sensibilmente diversa (non che sia necessaria chissà che velocità, però lo trovo strano) e con i nuovi oggetti ottengo una risposta decisamente più lenta.

[scossa]

ciao a tutti,
con tutte le istruzioni apprese in questo forum speravo di riuscire ad attualizzare e perfezionare un file excel che avevo realizzato 2 anni fa per gestire la raccolta di figurine di mio figlio.
Purtroppo noto con sconforto che non ho fatto grandi passi avanti.
Il file può essere scaricato qui:
https://rapidshare.com/files/2875277357/figurine2012.xls
Ho fallito miseramente in particolare per questi punti:
- vorrei modificare lo stato di una figurina solo con un clic e non dover premere il pulsante

Con un solo click è problematico (non esiste l'evento _click() ma solo selection_change()) per cui propongo il doppio click sulla cella per ciclare tra BUONA -> DOPPIA -> MANCANTE

- ho dovuto ricorrere ad un foglio d'appoggio in cui inserisco un numero che rappresenta lo stato delle figurine sul primo foglio, preferirei avere un solo foglio

Ho usato due nomi: [figurine] per il range delle figurine e [buone] per il conteggio delle buone.
vedi allegato.

Infine una curiosità: volevo abbellire i pulsanti creati in precedenza ma non ci sono riuscito. Allora ho creato degli oggetti attribuendo loro una macro. La velocità di esecuzione è sensibilmente diversa (non che sia necessaria chissà che velocità, però lo trovo strano) e con i nuovi oggetti ottengo una risposta decisamente più lenta.

Scusa ma se hai detto che non vuoi usare i pulsanti!
Nel file che ti allego ho eliminato i pulsanti e il foglio di appoggio.
Per i due elenchi vedrò poi.
Figurine2012v2

[Flash30005]

Leggi anche il post di Scossa

Per avere i colori nelle celle con la semplice selezione
opterei con una convalida elenco nella Cella AD1
Con i seguenti valori

Codice: Seleziona tutto

I;D;C

I = Inserita
D = Doppia
C= Cancella
e nel foglio "Album" inserisci questa macro

Codice: Seleziona tutto

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
CheckArea = "B1:T29,B30:K30"
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then Exit Sub
If [AD1] = "I" Then Col = 41
If [AD1] = "D" Then Col = 43
If [AD1] = "C" Then Col = xlNone
ActiveCell.Interior.ColorIndex = Col
End If
End Sub

Per gli altri quesiti sto vedendo...
Ciao

[wallace&gromit]

grazie mille per gli spunti,
per quanto riguarda la selezione delle celle penso di essere a posto (combino le vostre due indicazioni facendo in modo che al primo clic semplice una cella diventa sempre blu e con doppio clic gestisco i passaggi successivi).

Ora sarebbe interessante risolvere gli altri punti (la lista di "cerco" e "offro" in base alle scelte eseguite).

Per scossa: la questione dei pulsanti è solo una curiosità, hai ragione che lo scopo era rinunciarvi (scopo ora raggiunto).

[Flash30005]

Nel Foglio ho modificato la macro così

Codice: Seleziona tutto

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
CheckArea = "B1:T29,B30:K30,AJ1"
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
    If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then Exit Sub
    If [W1] = "I" Then Col = 41
    If [W1] = "D" Then Col = 43
    If [W1] = "C" Then Col = xlNone
    ActiveCell.Interior.ColorIndex = Col
    If Target.Address = "$AJ$1" Then Call TrovaF
End If
End Sub

In un modulo ho inserito questa macro

Codice: Seleziona tutto

Sub TrovaF()
UR = Range("B" & Rows.Count).End(xlUp).Row
CBuone = 0
CDoppie = 0
CManc = 0
Range("AJ2:AK10000").ClearContents
For RR = 1 To UR
For CC = 2 To 20
    If Cells(RR, CC).Value <> "" Then
        If Cells(RR, CC).Interior.ColorIndex = 41 Then CBuone = CBuone + 1
        If Cells(RR, CC).Interior.ColorIndex = 43 Then
            CDoppie = CDoppie + 1
            URD = Range("AK" & Rows.Count).End(xlUp).Row + 1
            Range("AK" & URD).Value = Cells(RR, CC).Value
        End If
        If Cells(RR, CC).Interior.ColorIndex = xlNone Then
            CManc = CManc + 1
            URM = Range("AJ" & Rows.Count).End(xlUp).Row + 1
            Range("AJ" & URM).Value = Cells(RR, CC).Value
        End If
    End If
Next CC
Next RR
[Y2] = CBuone + CDoppie + CManc
[AA2] = CBuone + CDoppie
[AC2] = CManc
End Sub

La macro si attiva selezionando AJ1 dove ho scritto "Cerco" e in AK1 "Offro"
Ho spostato la cella convalida da AD1 a X1 (come si evince dalla macro del foglio)
Ho spostato l'intero riquadro dei totali portandolo nel range Y1:AH2
in AE2 inserito la formula:

Codice: Seleziona tutto

=AA2/Y2

In quanto la macro troverà i totali (figurine) di Y2, AA2, AC2
e creerà l'elenco nella colonna AJ (Cerco) e AK (Offro)
Ho quindi cancellato le scritte al di sotto della tabella figurine per poter calcolare le righe effettive.

Allego il file

Ciao

EDIT ore 18:00 -
Per ovviare all'inconveniente della casella di convalida e colorare le celle con il solo click del mouse si potrebbe utilizzare una macro di questo tipo (da inserire nel foglio al posto della precedente):

Codice: Seleziona tutto

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
CheckArea = "B1:T29,B30:K30,AJ1"
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
    If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then Exit Sub
    Select Case ActiveCell.Interior.ColorIndex
    Case xlNone
    ActiveCell.Interior.ColorIndex = 41
    Case 41
    ActiveCell.Interior.ColorIndex = 43
    Case 43
    ActiveCell.Interior.ColorIndex = 41
    End Select
    If Target.Address = "$AJ$1" Then Call TrovaF
End If
End Sub


Perché a rigor di logica si tende a incrementare il numero delle figurine quindi ad avere sempre più figurine e le celle vanno quindi colorate o Blu o Verde se doppioni
Quando la figurina non la si ha la cella è senza colore, quando la si acquista o la si trova con un click la cella diviene Blu, se è doppione con un altro click diviene verde.
A questo punto la si offre in cambio di altra figurina, quindi, cliccandoci su da verde torna blu, non credo mai che debba tornare senza colore (si offre l'unica figurina che si ha nel catalogo ? )
Se proprio si vuol togliere il colore allora aggiungi anche questo codice nel foglio

Codice: Seleziona tutto

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
CheckArea = "B1:T29,B30:K30"
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
    If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then Exit Sub
    ActiveCell.Interior.ColorIndex = xlNone
End If
End Sub


Con il doppio click si resetta il fondo della cella

[scossa]

grazie mille per gli spunti,
per quanto riguarda la selezione delle celle penso di essere a posto (combino le vostre due indicazioni facendo in modo che al primo clic semplice una cella diventa sempre blu e con doppio clic gestisco i passaggi successivi).

Ora sarebbe interessante risolvere gli altri punti (la lista di "cerco" e "offro" in base alle scelte eseguite).

Per scossa: la questione dei pulsanti è solo una curiosità, hai ragione che lo scopo era rinunciarvi (scopo ora raggiunto).

Non ho capito come vuoi i due elenchi cerco e offro, quindi li scrivo come stringa nelle celle C32 e C34.

Il tutto avviene in automatico e gli elenchi vengono aggiornati in tempo reale.
Qui il file:
figurine2012v3.xls

Il cuore di tutto è la routine CercoOffro() che viene chiamata sia all'apertura del file (nell'evento Workbook_Open):

Codice: Seleziona tutto

Private Sub Workbook_Open()
  Call CercoOffro
End Sub


Sia ad ogni doppio-click di una cella delle figurine (evento Worksheet_BeforeDoubleClick):

Codice: Seleziona tutto

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  If Not Intersect(Target(1, 1), [figurine]) Is Nothing Then
    Dim cella As Range
    Dim nBuone As Integer
    Dim j As Variant
    Dim sFigure As String
    Set cella = Target(1, 1)
    nBuone = Mid(ThisWorkbook.Names("buone"), 2) * 1
    With cella
      Select Case .Interior.ColorIndex
        Case Is = xlNone
          .Interior.ColorIndex = 41
          ThisWorkbook.Names("buone").RefersTo = "=" & nBuone + 1
          cCerco.Remove (CStr(.Value))
        Case Is = 41
          cOffro.Add .Value, CStr(.Value)
          .Interior.ColorIndex = 43
        Case Is = 43
          .Interior.ColorIndex = xlNone
          ThisWorkbook.Names("buone").RefersTo = "=" & nBuone - 1
          cOffro.Remove (CStr(.Value))
          cCerco.Add .Value, CStr(.Value)
      End Select
    End With
    Call CercoOffro 'Elenchi
  End If
End Sub

Questo il codice della sub CercoOffro() da inserire in un modulo standard:

Codice: Seleziona tutto

Public cCerco As Collection
Public cOffro As Collection
   
Public Sub CercoOffro()
  Dim cella As Range
  Dim j As Long
  Dim k As Variant
  Dim sCerco As String
  Dim sOffro As String
 
  Application.ScreenUpdating = False
  Set cCerco = New Collection
  Set cOffro = New Collection
  On Error Resume Next
  For Each cella In [figurine]
    With cella
      j = j + 1
      Select Case .Interior.ColorIndex
        Case xlNone
          cCerco.Add .Value, CStr(.Value)
        Case 43
          cOffro.Add .Value, CStr(.Value)
      End Select
    End With
  Next
  On Error GoTo 0
  sCerco = ""
  For Each k In cCerco
    sCerco = sCerco & ":" & k
  Next
  sCerco = Mid(sCerco, 2)
  sOffro = ""
  For Each k In cOffro
    sOffro = sOffro & ":" & k
  Next
  sOffro = Mid(sOffro, 2)
  Album.Range("C32").Value = sCerco
  Album.Range("C34").Value = sOffro
  Application.ScreenUpdating = True
End Sub


Fai sapere, grazie.

[wallace&gromit]

Ciao a entrambi, Flash e Scossa, grandi come sempre!!!
Le vostre due soluzioni hanno entrambe qualcosa che mi piace, quindi ne ho fatto un mix.
Da Flash ho preso la soluzione del clic sulla cella (però faccio chiamare la routine CercoOffro di Scossa):

Codice: Seleziona tutto

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
CheckArea = "B1:T29,B30:K30"
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
    If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then Exit Sub
    Select Case ActiveCell.Interior.ColorIndex
    Case xlNone
    ActiveCell.Interior.ColorIndex = 41
    Case 41
    ActiveCell.Interior.ColorIndex = 43
    Case 43
    ActiveCell.Interior.ColorIndex = xlNone
    End Select
Call CercoOffro
Range("A15").Select
End If
End Sub

Inoltre ho aggiunto una cosa "brutta ma necessaria": seleziona una cella fuori dal range alla fine della modifica, altrimenti al secondo clic entro nella modifica della cella.
Momentaneamente rinuncio alla giusta intuizione di Flash: una volta che è appiccicata sull'album la figurina non la si scambia più.
Però non mi funziona il doppio clic (perchè si attiva subito la prima routine), e può sempre succedere di avere cliccato la cella sbagliata e volere correggere. Per il momento quindi risolvo con il cilclo.

La routine CercoOffro è tale e quale quella di Scossa:

Codice: Seleziona tutto

Public Sub CercoOffro()
  Dim cella As Range
  Dim j As Long
  Dim k As Variant
  Dim sCerco As String
  Dim sOffro As String
 
  Application.ScreenUpdating = False
  Set cCerco = New Collection
  Set cOffro = New Collection
  On Error Resume Next
  For Each cella In [figurine]
    With cella
      j = j + 1
      Select Case .Interior.ColorIndex
        Case xlNone
          cCerco.Add .Value, CStr(.Value)
        Case 43
          cOffro.Add .Value, CStr(.Value)
      End Select
    End With
  Next
  On Error GoTo 0
  sCerco = ""
  For Each k In cCerco
    sCerco = sCerco & ":" & k
  Next
  sCerco = Mid(sCerco, 2)
  sOffro = ""
  For Each k In cOffro
    sOffro = sOffro & ":" & k
  Next
  sOffro = Mid(sOffro, 2)
  Album.Range("C32").Value = sCerco
  Album.Range("C34").Value = sOffro
  Application.ScreenUpdating = True
End Sub

Riassumendo vi chiedo ancora solo queste due cose:
- si può disattivare una cella senza selezionarne un'altra?
- è possibile lanciare il doppio clic senza attivare prima la routine del clic semplice?

[Flash30005]

Strano!
Se fai un doppio click veloce la cella torna senza colore di fondo
Non capisco come mai a te rimane colorata

Comunque se trovi più comodo il tasto destro puoi usare questo codice

Codice: Seleziona tutto

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
CheckArea = "B1:T29,B30:K30"
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
    If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then Exit Sub
    ActiveCell.Interior.ColorIndex = xlNone
End If
End Sub

Ciao

[wallace&gromit]

niente da fare!
anche con il clic destro subentra l'altra routine e mi colora di blu o di verde la cella!

[scossa]

Ciao,

......
Inoltre ho aggiunto una cosa "brutta ma necessaria": seleziona una cella fuori dal range alla fine della modifica, altrimenti al secondo clic entro nella modifica della cella.
....
Riassumendo vi chiedo ancora solo queste due cose:
- si può disattivare una cella senza selezionarne un'altra?
- è possibile lanciare il doppio clic senza attivare prima la routine del clic semplice?

Sinceramente wallace, e mi scuso per la franchezza, ma quella del "singolo click" mi sembra un inutile "capriccio" che crea solo difficoltà e complicazioni (vedi la "cosa brutta ma necessaria"): non sei libero di selezionare una cella che subito te la colora; qual'è il problema nell'usare sempre e semplicemente il doppio-click?

[wallace&gromit]

è vero che si tratta di un capriccio: il tuo file è perfettamente funzionante e ti ringrazio ancora.

Di Flash mi piaceva l'intuizione che generalmente non si passa da verde a bianca (assente) ma a blu (la figurina nell'album una volta messa rimane) a meno che sia stato commesso un errore (cosa che però può succedere) e comunque, inserendo una serie di figurine con il clic semplice è tutto più immediato.

Il problema della "deselezione" esiste anche da te: se dovessi passare direttamente da vuota a doppia vorrei poter fare doppio clic due volte sulla stessa cella, invece la seconda volta entro nella modifica del testo.
Attualmente ho risolto con select.range("A15") ma non è il massimo.

[scossa]

è vero che si tratta di un capriccio: il tuo file è perfettamente funzionante e ti ringrazio ancora.

Il problema della "deselezione" esiste anche da te: se dovessi passare direttamente da vuota a doppia vorrei poter fare doppio clic due volte sulla stessa cella, invece la seconda volta entro nella modifica del testo.
Attualmente ho risolto con select.range("A15") ma non è il massimo.

Questo problema a me non succede e credo dipenda dalle tue impostazioni di excel: controlla nel menù opzioni -> tab Modifica l'opzione Modifica direttamente nella cella probabilemnte da te c'è il segno di spunta.
Io non attivo mai questa impostazione, appunto perchè crea problemi di questo tipo e perché trovo "fastidioso" editare direttamente nelle celle anziché nella apposita finestra delle funzioni fx.

Edit: per il problema di evitare di passare dal verde (doppia) al vuoto (manca) ma tornare al blu (presente) basta modificare il select case per il colore verde (43) come segue:

Codice: Seleziona tutto

        Case Is = 43
          .Interior.ColorIndex = 41
          cOffro.Remove (CStr(.Value))


In questo modo le figurine "incollate" non le togli più

[Flash30005]

Devi avere qualche problema

Prova questo file

Per caso hai office 2007 o superiore?

cioa

[wallace&gromit]

penso di avere identificato il problema: ed è proprio quell'aggiunta che ho fatto io.
Per potere passare subito da blu a verde ho introdotto un select.range("A15"), significa che alla fine della routine clic non ho più selezionata la cella. Questo implica che però la seconda azione non parte (senza accorgerci il richt clic parte sempre dopo il selction change).
Ora ho tolto questa mia aggiunta e funziona come nel file postato da flash.
Ci lavoro ancora un attimo poi allego il file definitivo.

[wallace&gromit]

Devi avere qualche problema

Questo comunque (anche più di uno ).
Però ho messo a punto il programmino che mi soddisfa:
con clic semplice inserisco una buona o ciclo da buona a doppia,
con doppio clic inserisco direttamente una doppia,
con clic destro cancello il contenuto.
CercoOffro parte sempre automaticamente e ricalcola il tutto, così vedo subito nelle caselle rosa a che punto è l'album.
Il file si può scaricare qui:
https://rapidshare.com/files/1443438563/figurine2012v4.xls

Ora, premesso che non ho ancora provato a convincere nessun conoscente a utilizzare lo stesso file. Il mio obiettivo sarebbe quello di potere inserire nelle celle Z32 e Z34 la situazione di un altro e vedere rappresentati in Z38 e Z40 tutti gli scambi possibili.
Ce la fate a fare ancora questo per me? In cambio vi mando una figurina di Maradona (ah no! sono gli Europei!)

[Flash30005]

Beh sinceramente dare 28 figurine in cambio di 5 non mi conviene

In pratica il programma dovrebbe vedere cosa offri, confrontare con ciò che cerca il tuo corrispondente
e inserire nel box solo le figurine che non ha
Viceversa, vedere cosa offre, confrontare con quello che cerchi e assegnarti solo quelle che non hai.
Però, ora, essendo tutte le figurine concatenate la macro diviene più complessa
mentre, se fossero state in colonna, come nell'esempio del mio file,
la funzione sarebbe stata molto ma molto più semplice.
Penso te ne sia accorto anche tu, vero?

ciao

[Anthony47]

Per incrociare la domanda con l' offerta la cosa piu' semplice che mi viene in mente e' usare formule del tipo

Codice: Seleziona tutto

=prendo(C32;Z34)


Codice: Seleziona tutto

=cedo(C34;Z32)

Presuppone che in un modulo standard sia presente il seguente codice:

Codice: Seleziona tutto

Function prendo(ByRef myCerco As Range, ByRef yOffri As Range) As String
'vedi http://www.pc-facile.com/forum/viewtopic.php?f=26&t=95329&p=546231#p546231
'
' Come si usa:
' usare una formula del tipo =prendo(CioCheCercoIo; CioCheOffriTu)
' es =prendo(C32;Z34)
'
' Es di dati in C32 /Z34: 000;00;6;7;8;9;10;11;12;13;14;15;16;17;18;19;20;21
'
Dim myManc, yExtra, FlMatch As Boolean, I As Integer, J As Integer
If Len(myCerco.Value) > 1 Then myManc = Split(myCerco.Value, ";")
If Len(yOffri.Value) > 1 Then yExtra = Split(yOffri.Value, ";")
For I = 0 To UBound(myManc, 1)
    FlMatch = False
    For J = 0 To UBound(yExtra, 1)
        If myManc(I) = yExtra(J) Then
            prendo = prendo & myManc(I) & "; "
            Exit For
        End If
    Next J
Next I
End Function

Function Cedo(ByRef myOffro As Range, ByRef yCerchi As Range) As String
'http://www.pc-facile.com/forum/viewtopic.php?f=26&t=95329&p=546231#p546231
'
' Come si usa:
' usare una formula del tipo =cedo(CioCheOffroIo; CioCheCerciTu)
' es =Cerco(C34;Z32)
'
' Es di dati in C34 /Z32: 000;00;6;7;8;9;10;11;12;13;14;15;16;17;18;19;20;21
'
Dim yManc, myExtra, FlMatch As Boolean, I As Integer, J As Integer
If Len(myOffro.Value) > 1 Then myExtra = Split(myOffro.Value, ";")
If Len(yCerchi.Value) > 1 Then yManc = Split(yCerchi.Value, ";")
For I = 0 To UBound(myExtra, 1)
    For J = 0 To UBound(yManc, 1)
        If myExtra(I) = yManc(J) Then
            Cedo = Cedo & myExtra(I) & "; "
            Exit For
        End If
    Next J
Next I
End Function


Prova e fai sapere.

Ciao

[wallace&gromit]

Perfetto!
grazie all'intervento di Anthony il file è proprio completo.
Per Flash: il vantaggio del sistema proposto da Scossa è che si può inviare una mail con i dati (cerco, offro) più facilmente, ora dovrò convincere altri ad utilizzare lo stesso sistema.
Magari con la scusa dell'innovazione tecnologica (e che l'album è di mio figlio) riesco ad abbindolare qualcuno con qualche scambio, ma credo anche io che non saranno così "impari", ma anche l'esempio era un po' a sbalzo.

Carico qui la versione finale del file nella speranza che possa servire a qualcun'altro. Fatemi sapere.

https://rapidshare.com/files/2339530636/figurine2012v5.xls

grazie a tutti ancora per il prezioso contributo.

[scossa]

Perfetto!

Carico qui la versione finale del file nella speranza che possa servire a qualcun'altro. Fatemi sapere.

https://rapidshare.com/files/2339530636/figurine2012v5.xls

Io sposterei

Codice: Seleziona tutto

Call CercoOffro

all'interno dei vari if altrimenti lo esegui anche per il doppio-click od il right-click esterno a CheckArea.

[wallace&gromit]

giustissimo!
questo corregge anche quel "saltino" che si notava cliccando in qualsiasi posizione e che io avevo cercato invano di risolvere con un screenUpdating = false.
Ancora grazie.