Macro Excel Click su cella e cambia valore

Hai un problema con Excel?

Nuova discussione

Macro Excel: Click su cella e cambia valore
di Macchia (utente non iscritto) data: 04/10/2013 11:49:36
Ciao a tutti,
sono abbastanza scarso con macro e VBA. Vorrei fare una cosa del genere:
Su un certo intervallo di celle, cliccando su una cella, al primo clic compare una lettera, al secondo un'altra, al terzo un'altra ancora, al quarto una diversa e al quinto la cella torna vuota. Inoltre è possibile che questo intervallo si possa espandere, aggiungendo righe e colonne.
Vi ringrazio per l'aiuto.
Ciao
di totygno71 (utente non iscritto) data: 04/10/2013 12:02:11
La vedo dura

di gaetanopr data: 04/10/2013 14:19:25
Prova la macro funziona con il doppioclick, da copiare direttamente sul foglio interessato
If then, si può sostituire con select case

Dim Controllo As Byte
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  
    If Intersect(Target, Range("A5")) Is Nothing Then Exit Sub
       
        Controllo = Controllo + 1
        If Controllo = 1 Then
            Target.Value = "A"
        ElseIf Controllo = 2 Then
            Target.Value = "B"
        ElseIf Controllo = 3 Then
            Target.Value = "C"
        ElseIf Controllo = 4 Then
            Target.Value = "D"
        ElseIf Controllo = 5 Then Target.Value = "": Controllo = 0: Exit Sub
        End If
        Cancel = True   ' serve a rendere non editabile la cella cliccata
End Sub

di Vecchio Frac data: 04/10/2013 14:27:12
La mia versione ^_^
Nel codice, ovviamente, di foglio1.
La parola nascosta compare in C1.
Allego anche il file.

Option Explicit

Const parola_nascosta = "ciao"

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Static indice As Integer

    If Target.Cells.Count > 1 Then Exit Sub
    
    Application.EnableEvents = False
    If Not Intersect(Target, [c1]) Is Nothing Then
        indice = indice + 1
        If indice >= Len(parola_nascosta) + 1 Then
            [c1] = ""
            indice = 0
        Else
            [c1] = Left(parola_nascosta, indice)
        End If
        [A1].Select
    End If
    Application.EnableEvents = True
End Sub

di totygno71 (utente non iscritto) data: 04/10/2013 15:29:30
Ragazzi ma questi sono surrogati...
L'amico Macchia chiedeva l'evento ad ogni singolo click della stessa cella... almeno questo ho capito io...
cit"cliccando su una cella, al primo clic compare una lettera, al secondo un'altra, al terzo un'altra ancora...
di Macchi (utente non iscritto) data: 04/10/2013 15:30:46
Grazie, l'idea che avevo è la prima proposta di gaetanopr. Ha un piccolo problema: Se voglio per esempio mettere in una cella dell'intervallo la A, e in un altra sempre A, clicco sulla prima cella e mi compare la A, ma se clicco sulla seconda compare direttamente la B. Si può sistemare questa cosa? grazie mille
di Macchia (utente non iscritto) data: 04/10/2013 15:36:39
totygno71 hai ragione, la mia idea era leggermente diversa, però mi adatto alle risposte che ricevo, non c'è problema. Meglio il singolo click ma mi posso accontentare anche del doppio. L'unico problema è quello che ho segnalato.
Grazie

di gaetanopr (utente non iscritto) data: 04/10/2013 15:42:39
prova questa

Dim Controllo As byte

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Cells.Count > 1 Then Exit Sub
    
    Application.EnableEvents = False
    If Intersect(Target, Range("A5:B5")) Is Nothing Then Exit Sub
       
        Controllo = Controllo + 1
        If Controllo = 1 Then
            Target.Value = "A"
        ElseIf Controllo = 2 Then
            Target.Value = "B"
        ElseIf Controllo = 3 Then
            Target.Value = "C"
        ElseIf Controllo = 4 Then
            Target.Value = "D"
        ElseIf Controllo = 5 Then Target.Value = "": Controllo = 0: Exit Sub
        End If
    Application.EnableEvents = True
End Sub

di gaetanopr (utente non iscritto) data: 04/10/2013 15:48:13
Questa non l'ho provata, "funziona" dovrebbe sulle celle A5 e B5
di Macchia (utente non iscritto) data: 04/10/2013 15:48:32
Ora non mi fa proprio niente...doppio click mi fa entrare solo nella cella, non compare più nulla.
di gaetanopr (utente non iscritto) data: 04/10/2013 15:55:16
Ciao macchia l'ultima che ti ho postato funziona con il doppoclick, altrimenti prova quella che ti ho postato in precedenza e cambia
If Intersect(Target, Range("A5")) Is Nothing Then Exit Sub con If Intersect(Target, Range("A5:B5")) Is Nothing Then Exit Sub 'prova alternandoti tra le due celle A5 e B5
di gaetanopr (utente non iscritto) data: 04/10/2013 15:58:25
cit>>Ragazzi ma questi sono surrogati...

Ciao totygno71 i surrogati sono sempre un punto di partenza, ad esempio quella di V.F mi è piaciuta veramente
di gaetanopr (utente non iscritto) data: 04/10/2013 16:02:11
cit>>Ciao macchia l'ultima che ti ho postato funziona con il doppoclick
scusami volevo dire click purtroppo scrivo con il cell.

Ciaoo
di Vecchio Frac data: 04/10/2013 16:09:44
Se ci fate caso, la mia versione funziona con un solo click nella cella C1, come da quesito iniziale... quella di totygno è tutta indivia ^_^
di Macchia (utente non iscritto) data: 04/10/2013 16:30:51
Forse mi ero spiegato male io all'inizio:
Se ho una tabella per esempio A1:C5, in ognuna delle celle che compongono la tabella devo poter cliccare per far uscire, prima A, sostituita poi dalla B e cosi via. Però il punto è che ogni volta che cambio cella, la cella deve partire dalla A, cioè: se in A1 clicco 3 volte e così compare la C, se clicco in A2 deve comparire A, non D come accade.
Grazie per l'aiuto in tutto.
di gaetanopr (utente non iscritto) data: 04/10/2013 17:46:14
Un' idea potrebbe essere, usando un array che raccoglie tutti gli indirizzi dei target e ad ogni click si controlla il target con quelli dell'array, quindi se trova 1 riscontro uguale scriverà B e cosi via

Stasera faccio qualche prova
di Vecchio Frac data: 04/10/2013 20:29:35
cit. "Forse mi ero spiegato male io all'inizio:"
---> Ah infatti io avevo capito diversamente :)
di tortyno (utente non iscritto) data: 04/10/2013 20:30:46
Se se....^_^

di gaetanopr data: 04/10/2013 23:30:16
cit>>Se ho una tabella per esempio A1:C5, in ognuna delle celle che compongono la tabella devo poter cliccare per far uscire, prima A, sostituita poi dalla B e cosi via. Però il punto è che ogni volta che cambio cella, la cella deve partire dalla A, cioè: se in A1 clicco 3 volte e così compare la C, se clicco in A2 deve comparire A, non D come accade.

Prova questa dovrebbe fare al caso tuo

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
    
    Application.EnableEvents = False
    If Intersect(Target, Range("A1:C5")) Is Nothing Then Exit Sub
   
        DATO = Target.Value
             
        Select Case DATO
         Case ""
         Target.Value = "A"
         Case "A"
         Target.Value = "B"
         Case "B"
         Target.Value = "C"
         Case "C"
         Target.Value = "D"
          Case "D"
         Target.Value = ""
        End Select

    Application.EnableEvents = True
End Sub

di gaetanopr data: 05/10/2013 00:55:58
Però secondo me è meglio sfruttare il doubleclick, almeno con questa macro, in modo da poter sostituire la lettera anche quando clicchi consecutivamente sulla stessa cella
di gaetanopr data: 05/10/2013 01:13:12
cit>>Però secondo me è meglio sfruttare il doubleclick, almeno con questa macro, in modo da poter sostituire la lettera anche quando clicchi consecutivamente sulla stessa cella

Oppure mi era sfuggito, data l'ora, spostare la selezione su un'altra cella a fine macro
ES: Range("D1").Select
di Vecchio Frac data: 05/10/2013 11:55:06
Esatto. Questa era stata anche la mia soluzione.
Farei anche attenzione alla verifica del dato (maiuscole/minuscole).
Per il resto ok.
di totygno71 (utente non iscritto) data: 05/10/2013 13:57:18
E se nea cella ci fosse "w" o "q" o "pippo"?

di gaetanopr data: 05/10/2013 14:20:43
cit>>>Esatto. Questa era stata anche la mia soluzione.
si ho visto adesso che avevi messo alla fine [A1].Select
Come fatto notare da V.F ho modificato la macro in modo da tener conto di eventuali maiuscole/minuscole

cit>>E se nea cella ci fosse "w" o "q" o "pippo"?
Rimarrebbe inalterata, nella select dovrà indicare solo i valori che devono essere cambiati

Allego macro

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
    
    Application.EnableEvents = False
    If Intersect(Target, Range("A1:C5")) Is Nothing Then Exit Sub
   
        DATO = UCase(Target.Value)
             
        Select Case DATO
         Case ""
         Target.Value = "A"
         Case "A"
         Target.Value = "B"
         Case "B"
         Target.Value = "C"
         Case "C"
         Target.Value = "D"
          Case "D"
         Target.Value = ""
        End Select
       
       [D1].Select
    
Application.EnableEvents = True
End Sub

di Macchia (utente non iscritto) data: 07/10/2013 11:52:40
Vi ringrazio, l'ultima è ciò di cui avevo bisogno. Un'ultima cosa che non capisco: Se clicco su una areaa diversa da quella del range della macro, in alcuni casi mi interrompe la macro e dunque se poi riclicco su una cella dell'intervallo, non va più la macro. Se ne seleziono altre sempre al di fuori del range e poi torno sul range invece continua a funzionare. Sapete perché?
grazie

di gaetanopr data: 07/10/2013 12:08:04
Non posso provare, ,ma prova ad invertire questa parte

 
    If Intersect(Target, Range("A1:C5")) Is Nothing Then Exit Sub
     Application.EnableEvents = False

di Macchia (utente non iscritto) data: 07/10/2013 12:11:10
Eccezionale! Ora tutto come desideravo. Grazie!
di Macchia (utente non iscritto) data: 07/10/2013 17:58:32
Un ultimo aiuto: Se oltre a questa macro ne volessi un'altra che su un altro range di celle cliccandoci sopra mi cambia il colore della cella tra 3 colori diversi oltre che il fondo trasparente, come posso fare? grazie
di gaetanopr data: 07/10/2013 18:59:10
Sempre in sequenza??
ti do un aiuto usa la macro di prima e invece di agire sul valore della cella, lavora sulla proprietà che definisce il colore di sfondo, quindi DATO = UCase(Target.Value) diventa
DATO = Target.Interior.ColorIndex
allo stesso modo modifica la select case.
In rete trovi i vari codici per i colori
di Macchia (utente non iscritto) data: 07/10/2013 19:02:58
Infatti per costruire la seconda macro x colorare le celle ci sono più o meno riuscito, ma non riesco a metterle insieme, cioè se metto la prima però non mi funziona l'altra...si capisce? Come strutturo il tutto per metterci le due macro diverse? grazie
di gaetanopr data: 07/10/2013 19:12:25
puoi usare una macro che a seconda del range selezionato richiamare la prima o la seconda macro

di gaetanopr data: 07/10/2013 19:35:16
cit>>ma non riesco a metterle insieme, cioè se metto la prima però non mi funziona l'altra..
Questo è un esempio di come dicevo prima, l'ho scritta velocemente quindi controllala bene

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
If Not Application.Intersect(Target, Range("A1:C5")) Is Nothing Then Call CambiaValore
If Not Application.Intersect(Target, Range("A6:C10")) Is Nothing Then Call Formatta
Application.EnableEvents = True
End Sub

Sub Formatta()
        
      DatoF = ActiveCell.Interior.ColorIndex
             
      With ActiveCell
        Select Case DatoF
         Case xlNone
         .Interior.ColorIndex = 3
         Case 3
         .Interior.ColorIndex = 4
         Case 4
         .Interior.ColorIndex = 5
         Case 5
         .Interior.ColorIndex = 6
         Case 6
         .Interior.ColorIndex = xlNone
         
        End Select
       End With
       [F1].Select
    

End Sub


Sub CambiaValore()

        DatoC = UCase(ActiveCell.Value)
        
       With ActiveCell
        Select Case DatoC
         Case ""
         .Value = "A"
         Case "A"
         .Value = "B"
         Case "B"
         .Value = "C"
         Case "C"
         .Value = "D"
          Case "D"
         .Value = ""
        End Select
       
       [D1].Select
      End With
End Sub

di Macchia (utente non iscritto) data: 08/10/2013 16:10:33
eccezionale! grazie

Vuoi Approfondire?