About Me
Com tecnologia do Blogger.
Seguidores
Estatisticas
2006-01-22
O MVP em Excel,Kirill Lapin, também conhecido por KL, apresentou uma alternativa ao post anterior, que pela sua qualidade e simplicidade, passo a referir:
O Código:
Private Sub CommandButton2_Click()
Dim r As Long
For r = UsedRange.Rows.Count To 1 Step -1
If Range("A" & r) = "" And Range("H" & r) = "" Then _
Range("A:H").Rows(r).Interior.ColorIndex = 48
Next r
End Sub
O Código:
Private Sub CommandButton2_Click()
Dim r As Long
For r = UsedRange.Rows.Count To 1 Step -1
If Range("A" & r) = "" And Range("H" & r) = "" Then _
Range("A:H").Rows(r).Interior.ColorIndex = 48
Next r
End Sub
2006-01-14
Se tivermos um determinado Range de dados como no exemplo que se segue:

e quisermos colorir as linhas totalmente em branco desse Range:

Podemos utilizar um pouco de VBA.
O Código:
Private Sub CommandButton2_Click()
Dim RowNdx As Long
Dim LastRow As Long
Dim x
Dim y
LastRow = ActiveSheet.UsedRange.Rows.Count
For RowNdx = LastRow To 1 Step -1
On Error Resume Next
x = Cells(RowNdx, "A").Value = ""
y = Cells(RowNdx, "H").Value = ""
If x Then
If y Then
Cells(RowNdx, "A").Interior.ColorIndex = 48
Cells(RowNdx, "B").Interior.ColorIndex = 48
Cells(RowNdx, "C").Interior.ColorIndex = 48
Cells(RowNdx, "D").Interior.ColorIndex = 48
Cells(RowNdx, "E").Interior.ColorIndex = 48
Cells(RowNdx, "F").Interior.ColorIndex = 48
Cells(RowNdx, "G").Interior.ColorIndex = 48
Cells(RowNdx, "H").Interior.ColorIndex = 48
End If
End If
Next RowNdx
End Sub
e quisermos colorir as linhas totalmente em branco desse Range:
Podemos utilizar um pouco de VBA.
O Código:
Private Sub CommandButton2_Click()
Dim RowNdx As Long
Dim LastRow As Long
Dim x
Dim y
LastRow = ActiveSheet.UsedRange.Rows.Count
For RowNdx = LastRow To 1 Step -1
On Error Resume Next
x = Cells(RowNdx, "A").Value = ""
y = Cells(RowNdx, "H").Value = ""
If x Then
If y Then
Cells(RowNdx, "A").Interior.ColorIndex = 48
Cells(RowNdx, "B").Interior.ColorIndex = 48
Cells(RowNdx, "C").Interior.ColorIndex = 48
Cells(RowNdx, "D").Interior.ColorIndex = 48
Cells(RowNdx, "E").Interior.ColorIndex = 48
Cells(RowNdx, "F").Interior.ColorIndex = 48
Cells(RowNdx, "G").Interior.ColorIndex = 48
Cells(RowNdx, "H").Interior.ColorIndex = 48
End If
End If
Next RowNdx
End Sub
2006-01-09
Por vezes podemos ter a necessidade de redefinir uma tecla para uma outra. No exemplo seguinte, redefine-se a tecla ENTER (incluindo a numérica) para a tecla TAB e provoca-se um avanço de uma coluna na mesma linha:
Sub Auto_open()
Application.OnKey "~", "JumpNext"
Application.OnKey "{ENTER}", "JumpNext1"
End Sub
Sub JumpNext()
r = ActiveCell.Row
c = ActiveCell.Column
If c >= 1 Then
c = c + 1
r = r
Else
End If
Cells(r, c).Activate
End Sub
Sub JumpNext1()
r = ActiveCell.Row
c = ActiveCell.Column
If c >= 1 Then
c = c + 1
r = r
Else
End If
Cells(r, c).Activate
End Sub
Sub Auto_open()
Application.OnKey "~", "JumpNext"
Application.OnKey "{ENTER}", "JumpNext1"
End Sub
Sub JumpNext()
r = ActiveCell.Row
c = ActiveCell.Column
If c >= 1 Then
c = c + 1
r = r
Else
End If
Cells(r, c).Activate
End Sub
Sub JumpNext1()
r = ActiveCell.Row
c = ActiveCell.Column
If c >= 1 Then
c = c + 1
r = r
Else
End If
Cells(r, c).Activate
End Sub
2006-01-03
Se tivermos preenchidas linhas, como no exemplo

e pretendermos inserir linhas em branco após 4 linhas de dados, ou seja, sempre à próxima 5ª linha,

podemos utilizar o seguinte Código, adaptado de Dave Peterson:
Private Sub CommandButton1_Click()
'Adiciona 1 linha em branco após 4 linhas
'Código original por: Dave Peterson
Dim iCtr As Long
Dim LastRow As Long
Dim myRng As Range
With ActiveSheet
LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
Set myRng = Nothing
For iCtr = 5 To LastRow Step 4
If myRng Is Nothing Then
Set myRng = .Cells(iCtr, "A")
Else
Set myRng = Union(.Cells(iCtr, "A"), myRng)
End If
Next iCtr
End With
If myRng Is Nothing Then
'Não faz nada
Else
myRng.EntireRow.Insert
End If
End Sub
e pretendermos inserir linhas em branco após 4 linhas de dados, ou seja, sempre à próxima 5ª linha,
podemos utilizar o seguinte Código, adaptado de Dave Peterson:
Private Sub CommandButton1_Click()
'Adiciona 1 linha em branco após 4 linhas
'Código original por: Dave Peterson
Dim iCtr As Long
Dim LastRow As Long
Dim myRng As Range
With ActiveSheet
LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
Set myRng = Nothing
For iCtr = 5 To LastRow Step 4
If myRng Is Nothing Then
Set myRng = .Cells(iCtr, "A")
Else
Set myRng = Union(.Cells(iCtr, "A"), myRng)
End If
Next iCtr
End With
If myRng Is Nothing Then
'Não faz nada
Else
myRng.EntireRow.Insert
End If
End Sub
Subscrever:
Mensagens (Atom)