VBA Excel - Não consigo montar

[aleciodi]

EXEMPLO DE PLANILHA ORÇAMENTÁRIA - DESPESAS GERAIS

JAN FEV MAR ABR MAI JUN

ALIMENTAÇÃO 250 280 300 285 330 350

EDUCAÇÃO 150 160 145 120 100 115

HABITAÇÃO 180 180 180 180 180 180

VESTUÁRIO 60 120 30 150 80 60

SAÚDE 100 60 80 60 50 50

DESPESAS PESSOAIS 90 60 40 80 70 90

TOTAL 830 860 775 875 810 845

SE B9 = 0 OCULTAR COLUNA SE NÃO DEIXAR COMO ESTÁ

SE C9 = 0 OCULTAR COLUNA SE NÃO DEIXAR COMO ESTÁ

SE D9 = 0 OCULTAR COLUNA SE NÃO DEIXAR COMO ESTÁ

SE E9 = 0 OCULTAR COLUNA SE NÃO DEIXAR COMO ESTÁ

SE F9 = 0 OCULTAR COLUNA SE NÃO DEIXAR COMO ESTÁ

SE G9 = 0 OCULTAR COLUNA SE NÃO DEIXAR COMO ESTÁ

Segue o link da planilha, pois a planilha acima talvez não estava muito clara.

http://www.4shared.com/document/jc_UC9Wo/Montar_VBA_-_Excel.html

Por favor me ajudem, Abs,

[Patropi]

Boa tarde aleciodi

Se você quiser postar a planilha para facilitar, use um site gratuíto como:

http://www.4shared.com/

Depois cole o link da planilha aqui no fórum

Um abraço

[diegobh]

Fiz uma macro, ficou um pouco grandinha pois sou iniciante em VB, mas se for conferir somente as células B9 até G9, ela funciona perfeitamente.

Vá na Aba Desenvolvedor, clica em Macros, Escreva: Ocultar (ou qualquer outro nome), clica em Criar.

Na tela que abrir, coloque o código da macro:

Dim Celula As String

    If Range("B9").Value = Empty Or Range("B9").Value = 0 Then
      CelulaL = ActiveCell.Row
      CelulaC = Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$", vbTextCompare) - 2)
      Celula = CelulaC & CelulaL
      Columns("B:B").Select
      Selection.EntireColumn.Hidden = True
      Range(Celula).Select
    End If

    If Range("C9").Value = Empty Or Range("C9").Value = 0 Then
      CelulaL = ActiveCell.Row
      CelulaC = Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$", vbTextCompare) - 2)
      Celula = CelulaC & CelulaL
      Columns("C:C").Select
      Selection.EntireColumn.Hidden = True
      Range(Celula).Select
    End If

    If Range("D9").Value = Empty Or Range("D9").Value = 0 Then
      CelulaL = ActiveCell.Row
      CelulaC = Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$", vbTextCompare) - 2)
      Celula = CelulaC & CelulaL
      Columns("D:D").Select
      Selection.EntireColumn.Hidden = True
      Range(Celula).Select
    End If

    If Range("E9").Value = Empty Or Range("E9").Value = 0 Then
      CelulaL = ActiveCell.Row
      CelulaC = Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$", vbTextCompare) - 2)
      Celula = CelulaC & CelulaL
      Columns("E:E").Select
      Selection.EntireColumn.Hidden = True
      Range(Celula).Select
    End If

    If Range("F9").Value = Empty Or Range("F9").Value = 0 Then
      CelulaL = ActiveCell.Row
      CelulaC = Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$", vbTextCompare) - 2)
      Celula = CelulaC & CelulaL
      Columns("F:F").Select
      Selection.EntireColumn.Hidden = True
      Range(Celula).Select
    End If

    If Range("G9").Value = Empty Or Range("G9").Value = 0 Then
      CelulaL = ActiveCell.Row
      CelulaC = Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$", vbTextCompare) - 2)
      Celula = CelulaC & CelulaL
      Columns("G:G").Select
      Selection.EntireColumn.Hidden = True
      Range(Celula).Select
    End If

Clica no disquete para Salvar e execute a macro.

[aleciodi]

Fiz uma macro, ficou um pouco grandinha pois sou iniciante em VB, mas se for conferir somente as células B9 até G9, ela funciona perfeitamente.

Vá na Aba Desenvolvedor, clica em Macros, Escreva: Ocultar (ou qualquer outro nome), clica em Criar.

Na tela que abrir, coloque o código da macro:

Dim Celula As String

    If Range("B9").Value = Empty Or Range("B9").Value = 0 Then
      CelulaL = ActiveCell.Row
      CelulaC = Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$", vbTextCompare) - 2)
      Celula = CelulaC & CelulaL
      Columns("B:B").Select
      Selection.EntireColumn.Hidden = True
      Range(Celula).Select
    End If

    If Range("C9").Value = Empty Or Range("C9").Value = 0 Then
      CelulaL = ActiveCell.Row
      CelulaC = Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$", vbTextCompare) - 2)
      Celula = CelulaC & CelulaL
      Columns("C:C").Select
      Selection.EntireColumn.Hidden = True
      Range(Celula).Select
    End If

    If Range("D9").Value = Empty Or Range("D9").Value = 0 Then
      CelulaL = ActiveCell.Row
      CelulaC = Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$", vbTextCompare) - 2)
      Celula = CelulaC & CelulaL
      Columns("D:D").Select
      Selection.EntireColumn.Hidden = True
      Range(Celula).Select
    End If

    If Range("E9").Value = Empty Or Range("E9").Value = 0 Then
      CelulaL = ActiveCell.Row
      CelulaC = Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$", vbTextCompare) - 2)
      Celula = CelulaC & CelulaL
      Columns("E:E").Select
      Selection.EntireColumn.Hidden = True
      Range(Celula).Select
    End If

    If Range("F9").Value = Empty Or Range("F9").Value = 0 Then
      CelulaL = ActiveCell.Row
      CelulaC = Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$", vbTextCompare) - 2)
      Celula = CelulaC & CelulaL
      Columns("F:F").Select
      Selection.EntireColumn.Hidden = True
      Range(Celula).Select
    End If

    If Range("G9").Value = Empty Or Range("G9").Value = 0 Then
      CelulaL = ActiveCell.Row
      CelulaC = Mid(ActiveCell.Address, 2, InStr(2, ActiveCell.Address, "$", vbTextCompare) - 2)
      Celula = CelulaC & CelulaL
      Columns("G:G").Select
      Selection.EntireColumn.Hidden = True
      Range(Celula).Select
    End If

Clica no disquete para Salvar e execute a macro.

Quando eu executo ela oculta todas as colunas, mesmo as que possuem valores diferente de zero. você pode verificar o que eu estou fazendo de errado.

Abs,

[aleciodi]

Boa tarde aleciodi

Se você quiser postar a planilha para facilitar, use um site gratuíto como:

http://www.4shared.com/

Depois cole o link da planilha aqui no fórum

Um abraço

http://www.4shared.com/document/jc_U...A_-_Excel.html

Se você puder me ajudar eu agradeço,

Abs.

[Visitante]

Sub OcultaColunas()
Dim x As Long
Columns("B:G").Hidden = False
    For x = 2 To 7
        If Cells(9, x) = 0 Then
            Columns(x).Hidden = True
        End If
    Next x
End Sub

[Patropi]

Boa noite aleciodi

Tentei baixar a tua planilha mas dá um aviso que o link não é valido.

Clique no link para você testar.

Um abraço

[aleciodi]

l

Boa noite aleciodi

Tentei baixar a tua planilha mas dá um aviso que o link não é valido.

Clique no link para você testar.

Um abraço

Patropi, Boa Noite,

Realmente o link que está aqui não estava abrindo, por isso, postei novamente e se acaso não der certo novamente por favor clique no link do dia 08.04 as 11:34,

http://www.4shared.com/document/jc_UC9Wo/Montar_VBA_-_Excel.html

Obrigado e Abs.

[Patropi]

Bom dia aleciodi

Veja se é isto que você quer.

http://www.4shared.com/document/DCgvPmjc/Montar_VBA_-_Excel_aleciodi_11.html

Eu aproveitei o excelente código do osvaldomp e alterei para funcionar automatico sem precisar de botão.

Teste aí porque eu sou iniciante em VBA e só estou tentando ajudar.

Um abraço

[aleciodi]

Bom dia aleciodi

Veja se é isto que você quer.

http://www.4shared.com/document/DCgvPmjc/Montar_VBA_-_Excel_aleciodi_11.html

Eu aproveitei o excelente código do osvaldomp e alterei para funcionar automatico sem precisar de botão.

Teste aí porque eu sou iniciante em VBA e só estou tentando ajudar.

Um abraço

Bom dia Patropi,

Fucionou perfeitamente, Muito Obrigado,

aleciodi.

[aleciodi]

Sub OcultaColunas()
Dim x As Long
Columns("B:G").Hidden = False
    For x = 2 To 7
        If Cells(9, x) = 0 Then
            Columns(x).Hidden = True
        End If
    Next x
End Sub

Oswaldomp, Bom dia,

Muito Obrigado pela ajuda, era exatamente o que eu precisava,

Valeu,

aleciodi.

[Flavio Soares]

Caso o autor do tópico necessite, o mesmo será reaberto, para isso deverá entrar em contato com a moderação solicitando o desbloqueio.