riga selezionata

[alexps81Moderatore alexps81 Karma: 55 pts]

Ottimo... grazie @scossa   

[frank_ciccioPartecipante frank_ciccio]

Tante soluzioni, a tutti.

[frank_ciccioPartecipante frank_ciccio]

Salve,

la macro di scossa messa in thisworkbook funziona per i fogli indicati.

Per funzionare bene devono essere tutti uguali.

Perchè funzioni in fogli diversi bisogna modificare la macro per inserirla nei fogli diversi e qui adattarla.

Non riesco qui a modificare, mi dà variabile non definita If Sh.Name

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
                             'Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  Dim rTable As Range, rRow As Range, nRows As Long
  
  If Sh.Name = "articoli" And Sh.Name = "archivio" Then 'solo per i fogli stesso nome
  
    'Set rTable = Intersect(Sh.UsedRange, Sh.UsedRange.Offset(1)) '<<< dalla riga2/tabella
    Set rTable = Intersect(Sh.UsedRange, Sh.Range("A2:R10000")) 'range
    
    If Not Intersect(Target, rTable) Is Nothing Then
      rTable.Interior.ColorIndex = xlNone
      For Each rRow In Selection.Areas
        With rRow
          Intersect(.EntireRow, rTable).Interior.ColorIndex = 8
        End With
      Next rRow
    End If
  Else
    Target.Calculate  '<<< per riga attiva colorata con formattazione
  End If

End Sub

 

 

[scossaPartecipante scossa Karma: 37 pts]

frank_ciccio ha scritto:

Non riesco qui a modificare, mi dà variabile non definita If Sh.Name

Sh è un argomento di Workbook_SheetSelectionChange, se usi  Worksheet_SelectionChange Sh non c'è perché non serve essendo il codice inserito nel modulo del singolo foglio quindi elimina If Sh.Name = "articoli" And Sh.Name = "archivio" Then 

P.S.: oltretutto per come l'hai scritta, quella condizione sarà sempre False perchè .Name non può essere "articoli" E (And) contemporaneamente "archivio" (avresti dovuto usare O (Or)).

[frank_ciccioPartecipante frank_ciccio]

Ora mi dà variabile non definita qui

Set rTable = Intersect(Sh.UsedRange, Sh.Range("A3:I10000")) 'range

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'per riga attiva colorata con formattazione nei fogli

  Dim rTable As Range, rRow As Range, nRows As Long
  
    'If Sh.Name = "articoli" Or Sh.Name = "Archivio" Then 'solo per i fogli stesso nome
    ActiveSheet.Unprotect "123456"
    
    'Set rTable = Intersect(Sh.UsedRange, Sh.UsedRange.Offset(1)) '<<< dalla riga2/tabella
    Set rTable = Intersect(Sh.UsedRange, Sh.Range("A3:I10000")) 'range
    
    If Not Intersect(Target, rTable) Is Nothing Then
      rTable.Interior.ColorIndex = xlNone
      For Each rRow In Selection.Areas
        With rRow
          Intersect(.EntireRow, rTable).Interior.ColorIndex = 8
        End With
      Next rRow
    End If
  Else
    Target.Calculate  '<<< per riga attiva colorata con formattazione
  End If
  
 ActiveSheet.Protect "123456"
End Sub

[frank_ciccioPartecipante frank_ciccio]

Ora va tolto Sh.

Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

  Dim rTable As Range, rRow As Range, nRows As Long
  
    'If Sh.Name = "articoli" And Sh.Name = "arrchivio" Then 'solo per i fogli stesso nome
    'Set rTable = Intersect(Sh.UsedRange, Sh.UsedRange.Offset(1)) '<<< dalla riga2/tabella
    'Set rTable = Intersect(Sh.UsedRange, Sh.Range("A2:R10000")) 'range
         
    'Set rTable = Intersect(UsedRange,UsedRange.Offset(1)) '<<< dalla riga2/tabella
    Set rTable = Intersect(UsedRange, Range("A2:R10000")) 'range
    
    
    If Not Intersect(Target, rTable) Is Nothing Then
      rTable.Interior.ColorIndex = xlNone
      For Each rRow In Selection.Areas
        With rRow
          Intersect(.EntireRow, rTable).Interior.ColorIndex = 8
        End With
      Next rRow
    'End If
  Else
    Target.Calculate  '<<< per riga attiva colorata con formattazione
  End If

End Sub

[Raffaele53Partecipante Raffaele53 Karma: 21 pts]

Ci sono alcune cose che non capisco(Target.Calculate). Per quanto abbia capito, mi sembrava che richiedevi di colorare una riga singola oppure due tre righe contigue? Se giusto nel post #45689 c'è la soluzione modificando la riga:
zona.Rows(RrI - 1 & ":" & RrF - 1).Interior.ColorIndex = 6

Per finire un ciclo For su 10.000 righe non mi sembra una cosa ragionevole per ogni volta che Ti sposti di cella.

[frank_ciccioPartecipante frank_ciccio]

Ciao raffaele la tua macro è buona, ma non funziona su celle contigue.

Per il ciclo 10000 righe era solo per provare, poi saranno molte di meno.

[Raffaele53Partecipante Raffaele53 Karma: 21 pts]

>>>ma non funziona su celle contigue ????????

Ps. Anche se non c'è scritto nulla e valido per le prime 100 righe

Allegati:

You must be logged in to view attached files.

[scossaPartecipante scossa Karma: 37 pts]

Raffaele53 ha scritto:

Per finire un ciclo For su 10.000 righe non mi sembra una cosa ragionevole per ogni volta che Ti sposti di cella.

Le righe non sono 10.000 ma solo quelle dell'itersezione tra le celle occupate ed il range A2:R10000:

Set rTable = Intersect(UsedRange, Range("A2:R10000")) 

Se hai valori solo nelle prime 20 righe (A1:AA20) il range reale sarà A2:R20.

[alexps81Moderatore alexps81 Karma: 55 pts]

Non ho capito ma quello che ti ha proposto scossa non va bene? Altrimenti questa qui che ti propongo io può andar bene? 

Tieni premuto CTRL e premi su una cella (o sul numero di rigo) e selezioni il rigo. Altrimenti click singolo per rigo singolo. Se fai click fuori dalla zona compilata allora si elimina tutta la selezione. Modifica il nome dei fogli che ti interessano nel rigo di codice:

If Sh.Name = "Articoli" Or Sh.Name = "Archivio" Then

`

Allegati:

You must be logged in to view attached files.

[frank_ciccioPartecipante frank_ciccio]

Alexps81 non posso provare la tua macr, mi da errore qui

Public Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

penso colpa della versione del mio excel.

So che c'era una soluzione per risolvere il problema di PtrSafe 

[frank_ciccioPartecipante frank_ciccio]

Ah ricordo qualche anno fa per una macro in ufficio, qui a casa funziona senza Ptrsafe

Public Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

Togli PtrSafe

Spiegazione tecnica piu' avanti   

[Autore]

Articoli