Selezionando cella selezionare riga

[giorgioa]

Salve a tutti,

cortesemente per una funzione che

nel selezionare una cella mi colori

in giallo la stessa riga

chiaro che selezionando un'altra cella

di un'altra riga il colore della riga precedente

si annulli

Grazie per l'aiuto
giorgioa
Utente Senior

Post: 573
Iscritto il: 16/04/12 15:00

[Anthony47]

Proud to be a senior member of this community

Fai tasto dx sul tab col nome de foglio, scegli Visualizza codice; copia questo codice e incollalo nel frame destro "vuoto" della finestra dell'editor delle mecro che e' stata così aperta:

Codice: Seleziona tutto

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Application.Intersect(Target.Cells(1, 1), Me.UsedRange) Is Nothing Then
        Me.UsedRange.Interior.Color = xlNone
        Application.Intersect(Target.Cells(1, 1).EntireRow, Me.UsedRange).Interior.Color = RGB(255, 255, 0)
    End If
End Sub

Poi torna sul foglio excel e vedi l'effetto che fa

Fai sapere...

[giorgioa]

Salve

la funtion funziona ma c'è un problema di foglio

il foglio su cui mi deve funzionare è il foglio1

se ti ricordi mi scrivesti un'altra function che mi colora delle celle

per cui trova quando clikko su una cella, un altro nominativo uguale e mi da errore

Private Sub Worksheet_SelectionChange(ByVal Target As Range) da cambiare se possibile

Intanto l'ho provato su un altro foglio ed ho visto che funziona

[Anthony47]

Eh, non mi ricordo quello che ho mangiato oggi, figurati se ricordo cosa avevo fatto per te in passato.

Pubblica la vecchia macro e vedremo di farle funzionare insieme (sempre che le due richieste possono convivere)

Ciao

[giorgioa]

SALVE,

quindi la prossima volta che ti invito a pranzo posso preparare anche la stessa minestra

a parte per non farti perdere tempo ti allego le tre funzioni compreso quella attuale, ultima delle 3,

che andrebbero caricate nel modulo foglio1

Codice: Seleziona tutto

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Warr, StRange As String, tVal
Dim i As Long, j As Long

If Not Application.Intersect(Target.Cells(1, 1), Range("Colora")) Is Nothing Then
    tVal = Target.Cells(1, 1)
    Warr = Range("C11:G200").Value
    For i = 1 To UBound(Warr)
        For j = 1 To UBound(Warr, 2)
            If Warr(i, j) = tVal Then
                StRange = StRange & "," & Range("C11").Cells(i, j).Address
            End If
        Next j
    Next i
    If Len(StRange) > 3 Then
        Me.Range(Mid(StRange, 2)).Interior.Color = Range("H1").Interior.Color
    End If
End If
End Sub

Codice: Seleziona tutto

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.Address = "$H$1" Then
    Range("C11:G2000").Interior.Color = xlNone
    Cancel = True
End If
End Sub

Codice: Seleziona tutto

Private Sub Worksheet_SelectionChangea(ByVal Target As Range)
    If Not Application.Intersect(Target.Cells(1, 1), Me.UsedRange) Is Nothing Then
        Me.UsedRange.Interior.Color = xlNone
        Application.Intersect(Target.Cells(1, 1).EntireRow, Me.UsedRange).Interior.Color = RGB(255, 255, 0)
    End If
End Sub

[Anthony47]

Le due SelectionChange potrebbero essere combinate in questo modo:

Codice: Seleziona tutto

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Warr, StRange As String, tVal
Dim i As Long, j As Long
'
If Not Application.Intersect(Target.Cells(1, 1), Me.UsedRange) Is Nothing Then
    Me.UsedRange.Interior.Color = xlNone
    Application.Intersect(Target.Cells(1, 1).EntireRow, Me.UsedRange).Interior.Color = RGB(255, 255, 0)
End If
If Not Application.Intersect(Target.Cells(1, 1), Range("Colora")) Is Nothing Then
    tVal = Target.Cells(1, 1)
    Warr = Range("C11:G200").Value
    For i = 1 To UBound(Warr)
        For j = 1 To UBound(Warr, 2)
            If Warr(i, j) = tVal Then
                StRange = StRange & "," & Range("C11").Cells(i, j).Address
            End If
        Next j
    Next i
    If Len(StRange) > 3 Then
        Me.Range(Mid(StRange, 2)).Interior.Color = Range("H1").Interior.Color
    End If
End If
End Sub


Non ci sono problemi per la BeforeDoubleClick, che quindi rimane invariata

Ciao

[giorgioa]

Salve Anthony

c'è un problema che potresti risolvere

mi spiego

la parte di macro che selezionando la cella colora la riga

va in conflitto con la tabella che colora il numero

a me interessa che quando seleziono la cella mi selezioni la riga

perchè questa parte di macro si appropria del colore assegnatole

alla tabella dei numeri da colorare

Per meglio spiegarmi: selezionando la cella mi selezioni la riga senza colore

Grazie

[Anthony47]

Eh, immaginavo che le due colorazioni avrebbero potuto andare in conflitto.
Se, invece di colorare, vuoi solo selezionare la riga, modifica come segue:

Codice: Seleziona tutto

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Warr, StRange As String, tVal
Dim i As Long, j As Long
'
Application.EnableEvents = False
If Not Application.Intersect(Target.Cells(1, 1), Me.UsedRange) Is Nothing Then
    Application.Intersect(Target.Cells(1, 1).EntireRow, Me.UsedRange).Select
'    Me.UsedRange.Interior.Color = xlNone
'    Application.Intersect(Target.Cells(1, 1).EntireRow, Me.UsedRange).Interior.Color = RGB(255, 255, 0)
End If
If Not Application.Intersect(Target.Cells(1, 1), Range("Colora")) Is Nothing Then
    tVal = Target.Cells(1, 1)
    Warr = Range("C11:G200").Value
    For i = 1 To UBound(Warr)
        For j = 1 To UBound(Warr, 2)
            If Warr(i, j) = tVal Then
                StRange = StRange & "," & Range("C11").Cells(i, j).Address
            End If
        Next j
    Next i
    If Len(StRange) > 3 Then
        Me.Range(Mid(StRange, 2)).Interior.Color = Range("H1").Interior.Color
    End If
End If
Application.EnableEvents = True
End Sub


Oltre a cambiare Colora con Seleziona ho aggiunto in testa e in coda Application.EnableEvents = False / True

Riprova...

[giorgioa]

OK Anthony 6 un MAGO

Grazie

RISOLTO