Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
If <> 0
 
Notifications
Clear all

If <> 0

 
2024 - VBA & Macros
Post Recente por guism 9 anos atrás
5 Posts
3 Usuários
0 Reactions
1,115 Visualizações
RSS
 guism
(@guism)
Posts: 14
Active Member
Topic starter
 

Tenho uma tabela com colunas de A até N. Criei um código que copia essa tabela para outra planilha, aplica um filtro na coluna M e deleta todos os resultados, depois desfaz o filtro e ajusta os dados da tabela (excluindo colunas, ajustando fonte, etc).

Meu problema é que o código só funciona se a coluna M tiver algum dado preenchido, se ela estiver em branco a planilha gerada fica em branco, preciso fazer uma condição if, mas acredito que esteja fazendo algo errado.

Estava tentando usar o código
if range("m2:m").value <> 0 then
aplica o filtro....
else
não aplica o filtro

 
Postado : 09/09/2015 11:23 am
 MPrudencio
(@mprudencio)
Posts: 2749
Famed Member
 

Posta a planilha com alguns dados de exemplo

Marcelo Prudencio
Microsoft Excel Brasil no Facebook

"Começar já é a metade do caminho."
Autor Desconhecido

Simplifica que simples fica.
Nicole Tomazella.

"O Simples é Sempre Melhor Que o Complicado"
Jorge Paulo Lemann.

 
Postado : 09/09/2015 11:25 am
 guism
(@guism)
Posts: 14
Active Member
Topic starter
 

Vou postar mais tarde, mas o código é esse ai.. como pode ver é mais formatação mesmo, tava tentando fazer o if como falei, mas continua não funcionando

If IsNull([prestada]) Then

ActiveWorkbook.Sheets("contas_abertas").Copy
Application.WindowState = xlMaximized
lastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Columns("G:O").Select
Selection.Delete Shift:=xlToLeft
Range("A1:F1").Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").ColumnWidth = 45.43
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B4").Select
Rows("1:1").RowHeight = 40.5
Range("A1:F1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    ActiveCell.FormulaR1C1 = "pres"
    Range(Selection, Cells(ActiveCell.Row, 1)).Select
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "NOME"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "MATRICULA"
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "Nº CONTA"
    Range("A1:F1").Select
    ActiveCell.FormulaR1C1 = "PRESTAÇÃO DE CONTAS EM ABERTO "
    Range("A1:F1").Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 22
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Selection.Font.Bold = True
    Range("A1:F1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Range("C2").Select
    Selection.Copy
    Range("A1:F1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1:F1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("Tabela1").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Font
        .Name = "Calibri"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Columns("B:B").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Range("A1:F1").Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 24
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("A2").Select

Else


ActiveWorkbook.Sheets("contas_abertas").Copy
Application.WindowState = xlMaximized
ActiveSheet.ListObjects("Tabela1").Range.AutoFilter Field:=13, Criteria1:="<>"
lastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Range("A2:A" & lastRow).Select
Selection.EntireRow.Delete
ActiveSheet.ListObjects("Tabela1").Range.AutoFilter Field:=13
Columns("G:O").Select
Selection.Delete Shift:=xlToLeft
Range("A1:F1").Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 20
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
Columns("A:A").EntireColumn.AutoFit
Columns("B:B").EntireColumn.AutoFit
Columns("C:C").ColumnWidth = 45.43
Columns("D:D").EntireColumn.AutoFit
Columns("E:E").EntireColumn.AutoFit
Columns("F:F").EntireColumn.AutoFit
Rows("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("B4").Select
Rows("1:1").RowHeight = 40.5
Range("A1:F1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    ActiveCell.FormulaR1C1 = "pres"
    Range(Selection, Cells(ActiveCell.Row, 1)).Select
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "NOME"
    Range("B2").Select
    ActiveCell.FormulaR1C1 = "MATRICULA"
    Range("A2").Select
    ActiveCell.FormulaR1C1 = "Nº CONTA"
    Range("A1:F1").Select
    ActiveCell.FormulaR1C1 = "PRESTAÇÃO DE CONTAS EM ABERTO "
    Range("A1:F1").Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 22
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorLight1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Selection.Font.Bold = True
    Range("A1:F1").Select
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With
    With Selection.Font
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
    End With
    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorLight2
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
    Range("C2").Select
    Selection.Copy
    Range("A1:F1").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("A1:F1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("Tabela1").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Font
        .Name = "Calibri"
        .Size = 12
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Columns("B:B").EntireColumn.AutoFit
    Columns("E:E").EntireColumn.AutoFit
    Range("A1:F1").Select
    With Selection.Font
        .Name = "Calibri"
        .Size = 24
        .Strikethrough = False
        .Superscript = False
        .Subscript = False
        .OutlineFont = False
        .Shadow = False
        .Underline = xlUnderlineStyleNone
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = 0
        .ThemeFont = xlThemeFontMinor
    End With
    Range("A2").Select
End If
 
Postado : 09/09/2015 11:32 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Na miscelânea de rotina acima, basicamente se vê perfumaria. A unica linha que remete ao filtro está sem valor
Experimente:
De:

ActiveSheet.ListObjects("Tabela1").Range.AutoFilter Field:=13, Criteria1:="<>"
lastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
Range("A2:A" & lastRow).Select
Selection.EntireRow.Delete

Para:

ActiveSheet.ListObjects("Tabela1").Range.AutoFilter Field:=13, Criteria1:="<>" & 0
'lastRow = Cells(Cells.Rows.Count, "A").End(xlUp).Row
'Range("A2:A" & lastRow).Select
'Selection.EntireRow.Delete

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 09/09/2015 1:15 pm
 guism
(@guism)
Posts: 14
Active Member
Topic starter
 

Não deu certo, acabei optando por fazer dois botões mesmo....

No primeiro deixei como estava e no segundo tirei as linhas abaixo:

ActiveSheet.ListObjects("Tabela1").Range.AutoFilter Field:=13, Criteria1:="<>" & 0
Range("A2:A" & lastRow).Select
Selection.EntireRow.Delete
ActiveSheet.ListObjects("Tabela1").Range.AutoFilter Field:=13

Deu certo por assim dizer haha

 
Postado : 22/09/2015 2:15 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico