cella,effetto interruttore.

[romeos]

Salve a tutti, all'interno di un foglio di lavoro ho una macro con all'interno questo frammento di codice:
CheckArea = " E3, E7, E11, E15,E19, E23, E27, E31, J5, J13, J21, J29, O9, O25"
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then Exit Sub
If ActiveCell.FormulaR1C1 = "V" = 6 Then
ActiveCell.FormulaR1C1 = "V" = xlNone
Else
ActiveCell.FormulaR1C1 = "V"
End If
End If
quello che vorrei ottenere è questo: clikkando una cella dovrebbe apparire la "V" se faccio un altro click dovrebbe scomparire la "V", in pratica effetto "interruttore" per capirci, quello che ottengo e che clikkando appare la "V" ma se riclikko non scompare,ho capito che molto probabilmente l'errore risiede in questa stringa:
If ActiveCell.FormulaR1C1 = "V" = 6 Then
ActiveCell.FormulaR1C1 = "V" = xlNone
ma ho provato varie soluzioni e vista le mia scarsa conoscenza in VBA non ne vengo a capo.

[ricky53]

Ciao,
immagino che il tuo codice sia inserito nell'evento "Doppio Click" !

Prova con questo esempio

Codice: Seleziona tutto

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    CheckArea = " E3, E7, E11, E15,E19, E23, E27, E31, J5, J13, J21, J29, O9, O25"
    If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
        If Selection.Rows.Count + Selection.Columns.Count > 2 Then Exit Sub
   
'...........................................
'If ActiveCell.FormulaR1C1 = "V" = 6 Then
'ActiveCell.FormulaR1C1 = "V" = xlNone
'Else
'ActiveCell.FormulaR1C1 = "V"
'End If

'  Questo è il codice che sostituisce il tuo
        If Target = "V" Then
            Target = ""
        Else
            Target = "V"
        End If
'...........................................
    End If
    Cancel = True

' .... altro tuo codice
' .... altro tuo codice
' .... altro tuo codice
End Sub

[scossa]

Salve a tutti, all'interno di un foglio di lavoro ho una macro con all'interno questo frammento di codice:
....ma ho provato varie soluzioni e vista le mia scarsa conoscenza in VBA non ne vengo a capo.

Ma postare l'intero codice della sub (presumo dell'evento Worksheet_SelectionChange, vista la presenza dell'argomento Target,) ti crea problemi?


P.S.: ho già visto utilizzata altre volte questa inutile complicazione:
If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then ......

ma perché non usare semplicemente
if Target.Cells.Count > 1 Then ....

che è più lineare e leggibile?

[ricky53]

Ciao Scossa,
anch'io avevo immaginato che Romeos utilizzasse l'evento "DOPPIO CLICK" e non ho guardato il resto del codice, ho solo corretto quello che non andava.

Riflettendo mi sono chiesto ma come si fa a selezionare, con il doppio click, più di una cella?
Quindi l'istruzione

Codice: Seleziona tutto

If Selection.Rows.Count + Selection.Columns.Count > 2 Then Exit Sub

non è necessaria.

A questo punto mi è venuto il dubbio che lui non utilizzi questo evento !!!

Anch'io chiedo il codice completo o con le istruzioni iniziali per capire cosa fare.

[scossa]

Ciao,
immagino che il tuo codice sia inserito nell'evento "Doppio Click" !

Ciao Ricky,

ci siamo sovrapposti, ma tu sei stato più buono :-)

Però secondo me non sta utilizzando l'evento "doppio click2 ma il "cambio selezione".

[ricky53]

Ciao Scossa,
ci siamo sovrapposti di nuovo.

Si è vero mi sono lasciato andare ed ho proposto la correzione senza chiedere di capire bene cosa lui stesse utilizzando come SEMPRE (o, adesso devo scrivere, SPESSO) faccio.

[romeos]

il codice è inserito nell'evento Worksheet_SelectionChange, comunque ho provveduto all'inserimento del tuo codice in tale evento , ho anche seguito il consiglio di Scossa e ho provveduto a rimuovere il codice da lui suggerito, è sembra funzionare tutto perfettamentequindi vi ringrazio infinitamente per l'aiuto, se nel testarlo noto anomalie vi faccio sapere,grazie ancora Ricky53.

[ricky53]

Ciao,
bene alla prossima.
Buon proseguimento e ... ci trovi QUI.


Consiglio: cerca di essere un po' più esplicativo nell'esporre le tue necessità e si arriverà bene e presto al risultato senza far fare, a noi che leggiamo, delle interpretazioni che potrebbero essere non esatte.

[romeos]

Ricky siete stati velocissimi nel rispondermi ed appena mi hai suggerito una soluzione ho cercato di ottimizzarla per le mie esigenze, mentre il post andava avanti con la discussione , lo riaperto per ringraziarvi, fatta mia l'esperienza se avrò ancora bisogno posterò il codice completo se ciò vi è utile per aiutarmi.
un saluto a presto.

[ricky53]

Ciao,
Ottimo.
alla prossima.

[scossa]

Ricky siete stati velocissimi nel rispondermi ed appena mi hai suggerito una soluzione ho cercato di ottimizzarla per le mie esigenze, ......

Secondo me, vista la tua seguente premessa:

.....ma ho provato varie soluzioni e vista le mia scarsa conoscenza in VBA non ne vengo a capo

non sarebbe male se postassi il tuo codice aggiornato per vedere insieme se e come si può migliorarlo, sempre ammesso che ti interessi approfondire la tua conoscenza del VBA.

[ricky53]

Ciao Scossa,
ottima proposta.
Se Romeos vuole approfondire la sua conoscenza del VBA io mi propongo per collaborare con te all'ottimizzazione del codice.

[romeos]

pensavo di non dover abusare troppo della vostra gentilezza, comunque il codice è questo e si riferisce ad un tabellone di gara con sanzioni e punteggi, sarei felice se potete migliorarlo, se serve altro sono a vostra disposizione.
P.S. come si puo postare il codice come fa ricky?

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

CheckArea = " B3:D3, B7:D7,B11:D11,B15:D15,B19:D19,B23:D23,B27:D27,B31:D31,G5:I5,G13:I13,G21:I21,G29:I29,L9:N9,L25:N25"
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then Exit Sub
If ActiveCell.Interior.ColorIndex = 3 Then
ActiveCell.Interior.ColorIndex = xlNone
Else
ActiveCell.Interior.ColorIndex = 3
End If
End If
CheckArea = " A3, A7, A11, A15, A19, A23, A27, A31, F5, F13, F21, F29,K9, K25 "
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then

If ActiveCell.Interior.ColorIndex = 6 Then
ActiveCell.Interior.ColorIndex = xlNone
Else
ActiveCell.Interior.ColorIndex = 6
End If
End If
CheckArea = " E3, E7, E11, E15,E19, E23, E27, E31, J5, J13, J21, J29, O9, O25"
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then

' Questo è il codice che sostituisce il tuo (effetto interruttore)
If Target = "V" Then
Target = ""
Else
Target = "V"
End If

End If
Cancel = True


End Sub

[ricky53]

Ciao,
primo consiglio_utilizza i TAG per il "codice": la leggibilità ne guadagna e tanto.
Pulsante "Code" posto sopra la finestra in cui si inseriscono gli interventi.

Secondo consiglio: utilizza l'indentazione del codice (vedi il codice che ti ho inviato io).
Qui la leggibilità ci guadagna e ... TANTISSIMO.

[romeos]

così

Codice: Seleziona tutto

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

CheckArea = " B3:D3, B7:D7,B11:D11,B15:D15,B19:D19,B23:D23,B27:D27,B31:D31,G5:I5,G13:I13,G21:I21,G29:I29,L9:N9,L25:N25"
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
    If (Selection.Rows.Count + Selection.Columns.Count) > 2 Then Exit Sub
    If ActiveCell.Interior.ColorIndex = 3 Then
        ActiveCell.Interior.ColorIndex = xlNone
    Else
       ActiveCell.Interior.ColorIndex = 3
    End If
End If
CheckArea = " A3, A7, A11, A15, A19, A23, A27, A31, F5, F13, F21, F29,K9, K25 "
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
   
    If ActiveCell.Interior.ColorIndex = 6 Then
        ActiveCell.Interior.ColorIndex = xlNone
    Else
       ActiveCell.Interior.ColorIndex = 6
    End If
 End If
 CheckArea = " E3, E7, E11, E15,E19, E23, E27, E31, J5, J13, J21, J29, O9, O25"
    If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
       
   '  Questo è il codice che sostituisce il tuo (effetto interruttore)
        If Target = "V" Then
            Target = ""
        Else
            Target = "V"
        End If

    End If
    Cancel = True


End Sub

[ricky53]

Ciao,
due consigli in uno. Bene.

ATTENZIONE: non hai inserito il codice che ti ha suggerito Scossa !

[romeos]

ho provveduto così...

Codice: Seleziona tutto

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

CheckArea = " B3:D3, B7:D7,B11:D11,B15:D15,B19:D19,B23:D23,B27:D27,B31:D31,G5:I5,G13:I13,G21:I21,G29:I29,L9:N9,L25:N25"
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
    If Target.Cells.Count > 1 Then Exit Sub
    If ActiveCell.Interior.ColorIndex = 3 Then
        ActiveCell.Interior.ColorIndex = xlNone
    Else
       ActiveCell.Interior.ColorIndex = 3
    End If
End If
CheckArea = " A3, A7, A11, A15, A19, A23, A27, A31, F5, F13, F21, F29,K9, K25 "
If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
   If Target.Cells.Count > 1 Then Exit Sub
    If ActiveCell.Interior.ColorIndex = 6 Then
        ActiveCell.Interior.ColorIndex = xlNone
    Else
       ActiveCell.Interior.ColorIndex = 6
    End If
 End If
 CheckArea = " E3, E7, E11, E15,E19, E23, E27, E31, J5, J13, J21, J29, O9, O25"
    If Not Application.Intersect(Target, Range(CheckArea)) Is Nothing Then
     If Target.Cells.Count > 1 Then Exit Sub
   '  Questo è il codice che sostituisce il tuo (effetto interruttore)
        If Target = "V" Then
            Target = ""
        Else
            Target = "V"
        End If

    End If
    Cancel = True


End Sub


[scossa]

ho provveduto così...

Codice: Seleziona tutto

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

CheckArea = " B3:D3, B7:D7,B11:D11,B15:D15,B19:D19,B23:D23,B27:D27,B31:D31,G5:I5,G13:I13,G21:I21,G29:I29,L9:N9,L25:N25"
......
CUT
.....
    Cancel = True

End Sub


Non vedendo il file e non potendo quindi sapere cosa c'è vado a naso, comunque cambierei il codice così:

Codice: Seleziona tutto

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  Dim CheckArea1 As String
  Dim CheckArea2 As String
  Dim CheckArea3 As String
  Dim bTarget As Boolean
 
  CheckArea1 = "B3:D3, B7:D7,B11:D11,B15:D15,B19:D19,B23:D23,B27:D27,B31:D31,G5:I5,G13:I13,G21:I21,G29:I29,L9:N9,L25:N25"
  CheckArea2 = "A3, A7, A11, A15, A19, A23, A27, A31, F5, F13, F21, F29,K9, K25 "
  CheckArea3 = "E3, E7, E11, E15,E19, E23, E27, E31, J5, J13, J21, J29, O9, O25"
 
  With Target
    If Not Application.Intersect(Target, Me.Range(CheckArea1)) Is Nothing Then
      If .Cells.Count > 1 Then Exit Sub
      If .Interior.ColorIndex = 3 Then
        .Interior.ColorIndex = xlNone
      Else
        .Interior.ColorIndex = 3
      End If
      bTarget = True
    ElseIf Not Application.Intersect(Target, Range(CheckArea2)) Is Nothing Then
      If Target.Cells.Count > 1 Then Exit Sub
      If ActiveCell.Interior.ColorIndex = 6 Then
        ActiveCell.Interior.ColorIndex = xlNone
      Else
        ActiveCell.Interior.ColorIndex = 6
      End If
      bTarget = True
    ElseIf Not Application.Intersect(Target, Range(CheckArea3)) Is Nothing Then
      If Target.Cells.Count > 1 Then Exit Sub
      '  Questo è il codice che sostituisce il tuo (effetto interruttore)
      If Target = "V" Then
        Target = ""
      Else
        Target = "V"
      End If
      bTarget = True
    End If
    If bTarget Then
      Application.EnableEvents = False
      Me.Range("A1").Select 'oppure .Offset(0, 1).Select
      Application.EnableEvents = True
    End If
  End With
End Sub

In pratica ogni volta che selezioni una cella dei vari Range "sensibili" viene poi selezionata una cella "estranea" (A1 o qualsiasi altra a piacere), in questo modo puoi riselezionare la precedente cella realizzando selettore on/off.

[romeos]

grazie mille Scossa ho provato e va ancora meglio, in pratica con il tuo codice non ho più la necessità di dover clikkare su una cella vuota "manualmente" per ripristinare on/off.Ho diverse tipologie di tabelloni molto simili, guardo se il tuo codice riesco ad implementarlo anche sugli altri in caso di problemi non esitero a chiedere aiuto Grazie 1000 .

[scossa]

Non vedendo il file e non potendo quindi sapere cosa c'è vado a naso, comunque cambierei il codice così:

Codice: Seleziona tutto

CUT
 
  With Target
    If Not Application.Intersect(Target, Me.Range(CheckArea1)) Is Nothing Then
      If .Cells.Count > 1 Then Exit Sub
....
CUT
End Sub

Ovviamente meglio spostare all'inizio e testare una sola volta se target è più di una cella:

Codice: Seleziona tutto

.....
With Target
    If .Cells.Count > 1 Then Exit Sub
    If Not Application.Intersect(Target, Me.Range(CheckArea1)) Is Nothing Then
    ......


togliendo gli altri If .Cells.Count > 1 Then Exit Sub