SaberExcel - o site das Macros

Esta macro do Aplicativo Microsoft Excel VBA, localiza a linha da última célula usada, e retrona uma msgbox,
na coluna A a partir da celula A1.

Excel VBA Estudos® >> www.saberexcel.com >> Escola de Informática



Sub Ultima_linha_celula()
Dim vlCelBusca As Long
On Error Resume Next
'Essas linhas comentadas abaixo você poderá usar como um ["Verfica Inconsistência"] se tal célula estiver vazia msgbox e sai da macro.
'If Sheets("Plan2").Cells(1, 1) = "" Then
' MsgBox ("É so digitar algo na Coluna A, Blz!"), vbInformation, "Saberexcel.com"
' Encontrar a última linha, que forneceu um texto ou valor.
' faz a busca aqui...
' Exit Sub
'Else
vlCelBusca = Cells.Find(What:="*", After:=Range("A1"), _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
MsgBox "A Linha ULTIMA CELULA usada esta na linha é : " & vlCelBusca, vbInformation, "Saberexcel.com"
Sheets("Plan2").Cells(2, 3) = "A Linha ULTIMA CELULA usada esta na linha : - " & vlCelBusca
'End If
End Sub

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA - SaberExcel

Saberexcel o site de quem precisa aprender Macros Microsoft Excel VBA

Essa macro do Aplicativo Microsoft Excel VBA(Visual Basic Application), insere linhas em branco alternadas às linhas existentes em uma determinada planilha, e atendendo ao pedido da Silvia, Campinas-SP, que pede uma forma bem simples de copiar dados de determinada folha planilha para outra folha de planilha. Silvia, observe que no macro Copiar_para_teste(), abaixo eu nomeei as células a serem copiadas da folha de planilha auxiliar como 'dados', e também a célula(A1) da folha de planilha que receberá os dados como 'sba', observe

Sub Inserir_cinco_linhas_branco()

Dim vLinhasBranco As Long, rgLocaliza As Range, rgLinha As Range
Dim arrInserirLinhas() As String, vLinhaArray As Long
vLinhasBranco = 5

With Saber1 'determinando a planilha
Set rgLocaliza = .Range("A1:A14") 'select range to test
ReDim arrInserirLinhas(1 To 1)
For Each rgLinha In rgLocaliza.Rows
If rgLinha.Row > 1 Then 'skip row 1
If rgLinha.Cells(1, 1) <> rgLinha.Offset(-1, 0) Then
arrInserirLinhas(UBound(arrInserirLinhas)) = _
rgLinha.Row + ((UBound(arrInserirLinhas) - 1) * vLinhasBranco) & _
":" & (rgLinha.Row + ((UBound(arrInserirLinhas) - 1) * vLinhasBranco)) + vLinhasBranco - 1
vLinhaArray = UBound(arrInserirLinhas) + 1
ReDim Preserve arrInserirLinhas(1 To vLinhaArray)
End If
End If
Next rgLinha 'inserir Linhas

For vLinhaArray = LBound(arrInserirLinhas) To UBound(arrInserirLinhas)
If arrInserirLinhas(vLinhaArray) <> "" Then
.Rows(arrInserirLinhas(vLinhaArray)).Insert Shift:=xlDown
End If
Next vLinhaArray

End With
End Sub

'Silvia aqui esta a macro auxiliar para ajudar na realização do teste, como expliquei acima, tentei simplificar ao máximo a macro copiar e colar,
'atendendo seu pedido. Espero que o exemplo os ajude, Fique com Deus, Boa Sorte. Expedito Marcondes.
Sub copiar_teste()
[dados].Copy [sba]
End Sub




Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel




Publicidade
Compre com segurança, garantia e ótimos preços

Saberexcel - site das macros

Essas macros do Aplicativo Microsoft Excel VBA(Visual Basic Application) com auxilio de uma inputbox, ocultam linhas em determinada folha de planilha, a primeira macro voce poder digitar os números separados por vírgulas na inputbox, a segunda macro que também contém uma inputbox com argumento type=8, que permite selecionar as linhas na região que desejar ocultar determinadas linhas na folha de planilha.

Prezados senhores,
Será que seria possível uma macro que oculta linhas pre-definidas,
explico: preciso de uma macro que ocultam linhas pre-definidas, através de uma inputbox,ou mesmo a própria célula. É possível??, se puder me ajudar agradeço.
Rubens - fficop

R - Sim é possível veja, vou te enviar dois exemplos você poderá ver qual lhe
servirá melhor.


Este exemplo de macro voce digita na entrada de dados(Inputbox) o número das linhas
que precisa que ocultem, números separados por vírgulas,
Ex. 5,6,7,8,9,29,34,85, etc..
Espero que lhe seja útil, fique com Deus, Boa sorte.
Expedito Marcondes

Sub Ocultar_linhas_Inputbox()
Dim sB$, Ex, i%
Saber2.Select
linhas_ver
sB = InputBox("Entre com as linhas que deseja ocultar, separe-as por vírgula")
If sB = "" Then Exit Sub
Ex = Split(sB, ",")

For i = 0 To UBound(Ex)
On Error Resume Next 'tratando um possível erro!
Rows(Ex(i)).Hidden = True
On Error GoTo 0
Next

End Sub

'com essa macro usando uma entrada de dados inputbox, voce poderá ocultar linhas
'selecionando diretamente nas células. Espero que lhes seja útil.
Sub Ocultar_linhas_inputbox_I()
Dim c As Variant
Saber2.Select
linhas_ver
On Error Resume Next
Set c = Application.InputBox("Selecione o intervalo de células - para ocultar linhas !!!", "Saberexcel", , Type:=8)
If Err.Number = 0 Then c.EntireRow.Hidden = True
On Error GoTo 0
End Sub

Sub linhas_ver()
Cells.RowHeight = 14.25
Range("A1").Select
End Sub

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA(Visual Basic Application) , sozinho, praticando com os produtos didáticos SaberExcel

Saberexcel - o site das macros
Essas macros e procedimentos do Aplicativo Microsoft Excel VBA, deletam colunas ou linhas [PARES], observem também que inserí um menu personalizado para facilitar o teste do aluno desenvolvedor, se inserissemos algum botão na folha de planilha para o teste
certamente iria deletá-lo com os testes, então fiz o menu personalizado faça os testes através do menu personalizado, baixe o exemplo em um link no final da desta página

Sub Deletar_colunas_Pares()
'Determinar a última linha que contém valores
R = Cells.SpecialCells(xlCellTypeLastCell).Column
'Se a última coluna for ímpar, acrescentar 1 ao seu valor
If R Mod 2 <> 0 Then R = R + 1
'Realizar o loop decrescente de R até o valor 2 com incremento -2
For i = R To 2 Step -2
'Deletar a Coluna
Columns(i).Delete
Next i

End Sub

'Esta macro separa ímpares de pares somente por coluna. Teria como ela remover linha por linha ?

Sub Deletar_Linhas_Pares()
'Determinar a última linha que contém valores
R = Cells.SpecialCells(xlCellTypeLastCell).Row
'Se a última linha for ímpar, acrescentar 1 ao seu valor
If R Mod 2 <> 0 Then R = R + 1
'Realizar o loop decrescente de R até o valor 2 com incremento -2
For i = R To 2 Step -2
'Deletar a linha
Rows(i).Delete
Next i
End Sub

'inserindo um pequeno contador que insere autonumeracão números de 1 a 10
'intenção didática, de como inserir uma autonumeração.

Sub numerando_colunas()
[A1:A10].ClearContents
Range("A1").Select
For i = 1 To 10
ActiveCell.Offset(0, -1 + i ).Value = i
Next
End Sub

'Observe que mudamos a posição da variável "i" para posição row(linha) para autonumeração
'observe que a propriedade OffSet(linha, coluna) - descola linha e colunas.
Sub numerando_linhas()
[A1:L1].ClearContents

Dim s As String
Range("A1").Select
For i = 1 To 10
ActiveCell.Offset(-1 + i, 0).Value = i
Next i
End Sub

Sub dados()
Range("G14").Value = "Acesse o menu personalizado, para realizar os testes"
Range("G15").Value = "Fiz uma macro para montar um menu personalizado, "
Range("G16").Value = "pois irá deletar linhas e colunas."
Range("G17").Value = "com isso deletará dados na planilha"
Range("G13").Select
End Sub

EM OUTRO MÓDULO DE PROGRAMAÇÃO VOCE PODERÁ INSERIR OS PROCEDIMENTOS PARA O MENU PERSONALIZADO

Public Const CMDBARNOME = "LISTA MENU E CMDBAR"
Sub menu()

Dim cmdBar As CommandBar
Dim menu As CommandBarPopup
Dim btn As CommandBarButton

Call menuDel

Set cmdBar = CommandBars.Add(Name:=CMDBARNOME, Position:=msoBarFloating)
cmdBar.Width = 180
'.......'
Set menu = cmdBar.Controls.Add(Type:=msoControlPopup)
With menu
.Caption = "Deletando Linhas e Colunas"
.Width = 90
End With
'.......'
Set btn = menu.Controls.Add(Type:=msoControlButton)
With btn
.Caption = "Deletar Coluna Pares"
.OnAction = "Deletar_colunas_Pares"
End With
'.......'
Set btn = menu.Controls.Add(Type:=msoControlButton)
With btn
.Caption = "Deletar Colunas Pares"
.OnAction = "Deletar_Linhas_Pares"
End With
'.......'
Set menu = cmdBar.Controls.Add(Type:=msoControlPopup)
With menu
.Caption = "Numeros linhas e colunas"
.Width = 90

End With
'.......'
Set btn = menu.Controls.Add(Type:=msoControlButton)
With btn
.Caption = "Numerando Colunas"
.OnAction = "numerando_colunas"
.FaceId = 654
End With
'.......'
Set btn = menu.Controls.Add(Type:=msoControlButton)
With btn
.Caption = "Numerando Linhas"
.BeginGroup = True
.OnAction = "numerando_linhas"
.FaceId = 1044
End With
'.......'

With cmdBar
.Visible = True
.Protection = msoBarNoChangeDock + msoBarNoCustomize + msoBarNoResize
End With

End Sub

Sub menuDel()
On Error Resume Next
CommandBars(CMDBARNOME).Delete
End Sub

NO MODULO DE PROGRAMAÇÃO VBE DO WORKBOOK INSIRA OS SEGUINTES PROCEDIMENTOS
Private Sub Workbook_Open()
'Expedito Marcondes
'Site.....: http://www.saberexcel.com
'Email...: [email protected]
Call mnu
End Sub
'...........................'
Private Sub Workbook_BeforeClose(Cancel As Boolean)
menuDel
ThisWorkbook.Save
End Sub


Aprenda tudo sobre o Aplicativo Microsoft Excel VBA com Saberexcel



 

Compre com qualidade, segurança tudo que possa imaginar nas lojas Submarino

Saberexcel - O site das Macros

Essa macro do Aplicativo Microsoft Excel VBA(Visual Basic Application), deletam linhas baseada em critérios, neste caso
deletará linhas baseadas nas células em branco que existirem nas colunas: (F), (G), (H)

'simplificando códigos de programação ms excel vba.
Sub Deletar_Linhas_Celulas_Branco()
MsgBox ("Linhas onde houver células em branco na coluna(F:G:H) serão DELETADAS!!!!")
vUltimaLinha = Cells.SpecialCells(xlLastCell).Row

'montando o loop para verificar nas células vazias nas colunas específicas
'veja que a simetria e orgranização do código facilita o entendimento, obdeçam esse critério.
'
For i = vUltimaLinha To 1 Step -1
'-----------'
'Observem que não exisite o End If (fechando a estrutura if) - porque há uma condição verdadeira na frente do Then
If Cells(i, "F").Value = "" Then Rows(i).Delete
If Cells(i, "G").Value = "" Then Rows(i).Delete
If Cells(i, "H").Value = "" Then Rows(i).Delete
'-----------'
Next i

End Sub

Simplifiquei a estrutura da macro copiar e colar.
Os códigos copiam de uma planilha e cola em outra planilha na célula (A1)
você poderá nomear um range dinâmico para isso, cada vez que for inserido dados,
o range dinâmico expande com tamanho dos dados digitados.
Esse tipo de programação estarei explanando nos - Modulos Como Fazer - Saberexcel


'veja que uso o nome de código da folha de planilha(Saber1,Saber2), porque?,
'- Se o usuário mudar o nome da folha de planilha, não gera erro... certo?

Sub copiar_colar_teste()
Saber2.[A1:Q25].Copy Saber1.[A1]
End Sub

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo,
praticando com os produtos didáticos SaberExcel