Olá, boa tarde.
Estou com uma dificuldade em uma planilha e que me causa grande embaraço em reuniões. Há tempos aqui no fórum consegui 2 códigos que basicamente executam dois procedimentos. Parte do código bloqueia as fórmulas das células para alterações, logo eu passei a inserir títulos de colunas em fórmulas por exemplo ="Resultado do Período", assim esse título não pode ser alterado. Existem outras fórmulas que envolver números também. Como eu disse, funciona bem.
Mas na mesma planilha havia a necessidade de ocultar as linhas de um determinado intervalo que, no resultado de uma fórmula, fosse igual a "0". O intervalo em questão possui nas células uma operação de cálculo, quando o resultado é igual a zero, a linha é ocultada e o contrário se o valor for maior que zero. Também funciona bem.
Cada parte do código foram soluções em tempos distintos, ou seja, primeiro foi resolvido a questão da proteção e depois para ocultar as linhas. Eu tentei "UNIR" os códigos
e até consegui, mas ao longo do tempo percebi que todo os processo passou a demorar muito, quase 3 minutos para ser executado. Como usa-se muito o código, ficou quase impossível usá-lo.
Então estou postando o código completo para que alguém estude e veja se algo pode ser alterado para agilizar esse procedimento. Como disse, isso tem me causado grande embaraço em reuniões, pois o código faz parte de uma consulta e com a demora...algumas pessoas não entendem nada de execel e logo taxam as planilhas de "não presta" ou "não funciona".
Obrigado pela ajuda.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
ActiveSheet.Unprotect Password:="senha"
ActiveSheet.Protect Password:="senha", UserInterfaceOnly:=True
Cells.Locked = False
On Error Resume Next
Set rng = Cells.SpecialCells(xlCellTypeFormulas)
'Set rng = Cells.SpecialCells(XlCellTypeText) 'Text se quiser travar texto
If Err.Number > 0 Then
Set rng = Cells.SpecialCells(xlCellTypeConstants)
Else
Set rng = Union(rng, Cells.SpecialCells(xlCellTypeFormulas))
'Set rng = Cells.SpecialCells(XlCellTypeText)
End If
On Error GoTo 0
If Not rng Is Nothing Then rng.Locked = True
ActiveSheet.Protect Password:="senha", UserInterfaceOnly:=True
' União de 2 códigos
If Target.Address = "$C$7" Or Target.Address = "$N$42" Or Target.Address = "$S$7" Or Target.Address = "$AC$7" Then
'End Sub
'Private Sub Worksheet_Activate()
Application.ScreenUpdating = False
For Each cell In Range("$BW$2:$BW$150")
If cell.Value = 0 Then
cell.EntireRow.Hidden = True
Else
cell.EntireRow.Hidden = False
End If
Next
Application.ScreenUpdating = True
End If
Range("C13").Select
End Sub
Postado : 17/01/2016 4:05 pm