Excel planilha Funcao personalizada Contar ocorrencia palavras

Essa função personalizada do Aplicativo
Microsoft Excel VBA, retorna a quantidade de ocorrências de determinada palavra
em intervalo de célula.


Function Contar_ocorrencias(vArea As Range, Palavra As String) As Long
'Declarando as variaveis
Dim vCelula As Range
Dim i As Integer 'para o loop (contador)

'Variável Contar_ocorrencia igual a zero
Contar_ocorrencias = 0

'Loop para percorrer todas as 'vCelulas' do argumento (vArea)
For Each vCelula In vArea
'Percorrer todos os caracteres da célula
For i = 1 To Len(vCelula)
'esta linha de código faz a comparação nao diferenciando
letras maiusculas de minusculas
If UCase(Mid(vCelula, i, Len(Palavra))) = UCase(Palavra) Then Contar_ocorrencias
= Contar_ocorrencias + 1
Next i

Next vCelula

End Function

Fórmulas usadas...:
'="Há [ "&E5 & " ] ocorrencias da palavra [ "&B1 & " ] na range(B1:B16)"

="Há [ "&Contar_ocorrencias(B1:B16;B1) & " ] ocorrencias da
palavra [ "&B1 & " ] na range(B1:B16)"

Baixe o exemplo de planiha em nosso site.

http://www.saberexcel.com.br

há muitos downloads gratuitos.

Excel VBA Macros - Deleta linhas ou colunas em branco Planilha Excel VBA

Excel VBA Macros - Esta macro deleta linhas ou colunas em branco na planilha
do aplicativo MS Excel
'...........................................'
Sub Deleta_Linhas_Branco()
Sheets(”SuaPlanilha”).Select
Dim r, c, x As Integer
‘r esta é sua primeira linha na planilha excel
For r = 1 To 150
‘c é seu loop da primeira coluna da planilha excel até que c alcance 184 (improváveis)

For c = 1 To 184
’se a celula do excel determinada no loop estiver em branco
If Cells(r, c) = “” Then
‘procura proxima linha não branca - o número de coluna transformar-se-á x
x = Cells(r, c).End(xlToRight).Column
‘if x > 184 (sua ultima coluna) então você pode pular o pause desta lista como espaço em branco

If x > 184 Then GoTo 10
‘encontre o que a coluna antes da lista não-em branco faz o seguinte:
Y = x - 1
‘Teste a diferença entre a coluna que estão sendo processados e o y

Select Case Y - c
’se mais de uma lista atual no meio da lista em branco e não contiver espaço em branco seguinte suprimem então 'da escala dos espaços em branco
Case Is > 0
Range(Cells(r, c), Cells(r, Y)).Delete Shift:=xlToLeft

Case 0
’se diferença entre o & de y; c é 0 então somente uma Lista a Suprimir
Cells(r, c).Delete Shift:=xlToLeft

Case Else
’se it’ negativo de s você tem um erro!!
MsgBox “Error: Macro Will Stop”, vbCritical, “Error”
Exit Sub
End Select
End If
‘move para a proxima coluna
Next c
‘ 10 é usado como um atalho para interromper o loop acima… se 10 entende que estão toda em branco - o trabalho 'de deleção vai apenas para a lista seguinte ao 10
Next r
End Sub
'.....................................'
http://ww.saberexcel.com
o site das macros do Aplicativo MS Excel VBA Visual Basic Application
Coleção de 15.000 Macros, Fórmulas e Funções
'....................................'

':........................................................ ><((((º>
'Excel VBA Macros - Esta macro insere hiperlink na planilha um para navegar para outras planilhas.
'.......................................................'
Sub Lista_nome_das_planilhas_em_hyperlinks()
'.......................................................'
On Error Resume Next
Sheets.Add.Name = "Lista_Planilhas"
Sheets("Lista_Planilhas").Move Before:=Sheets(1)
Dim Minhas_Planilhas As Worksheet
Dim x As Integer
x = 1
For Each Minhas_Planilhas In Worksheets
Cells(x, 1).Select
ActiveCell = Minhas_Planilhas.Name
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", _
SubAddress:="'" & ActiveCell.Value & "'!A1" 'modif. 1
'SubAddress:=Chr(39) &ActiveCell.Value & Chr(39) & "!A1" 'modif. 2
'SubAddress:=ActiveCell.Value & "!A1"
x = x + 1
Next Minhas_Planilhas
x = 1
End Sub
'............................................'
O Site das macros Excel VBA Fórmulas e Funções
Coleção de 15.000 Macros, Funções e Fórmulas
http://www.saberexcel.com/
'...........................................'

Excel VBA Macros - Mudar a hora do sistema do computador

’Esta macro do Aplicativo Ms Excel emite uma mensagem, para mudar a hora do sistema - 'pergunta se deseja ou 'não alterar a hora do sistema de seu computador sim ou não resposta'.........................................'
Sub Mudar_data_Sistema()
Dim DATANOVA As Variant
If MsgBox("- Data do sistema: " & ; Format(Date, "dddddd") &  Chr(10) &  Chr(13) & "- Deseja Alterar?", 36, "Data Atual - Excel VBA Estudos®") = 6 Then
DATANOVA = InputBox("- Digite a nova data no formato dd/mm/aaaa ou pressione Enter para mantê-la")
If IsDate(DATANOVA) Then
Date = DATANOVAEnd IfEnd IfEnd Sub'.............................................'http://www.saberexcel.com
o Site das macros
Coleção de 25.000 Macros, Funções e Fórmulas do Aplicativo Excel VBA
'.....................................'

Excel VBA - Extração de número de loto , loteria

Excel VBA Macros Funcoes

Extração de número de
Excel VBA - Extração de número de loto , loteria
‘=AleatórioLoto(1;49;6)

Function AleatorioLoto(Botao As Integer, Top As Integer, Amount As Integer)
Dim iNum As String
Dim strNum As String
Dim i As Integer

Application.Volatile
iNum = Int((Top - Botao + 1) * Rnd + Botao)

For i = 1 To Amount
strNum = Trim(strNum & ” ” & iNum)
Do Until InStr(1, strNum, iNum) = 0
iNum = Int((Top - Botao + 1) * Rnd + Botao)
Loop
Next i

AleatorioLoto = strNum

End Function
‘———————————–‘
http://www.saberexcel.com
O site das 15.000 Macros, funcoes e formulas, planilhas, downloads, apostilas

Excel VBA Loto - extrai seis números aleatórios na planilha

Excel VBA Funcoes Formulas
Loto - extrai seis números aleatórios na planilha
ligar a macro e acioná-la.
‘Esta macro extrai 6 números aleatórios

Sub Loto()
Dim i, num, bolas(49)
For i = 1 To 49
bolas(i) = i
Next
Randomize Timer
For i = 1 To 6
num = 1 + Int((Rnd * (49 - i)))
ActiveCell.Offset(0, i - 1).Value = bolas(num)
bolas(num) = bolas(50 - i)
Next
End Sub
‘—‘
Site das Macros Excel VBA
( 15.000 Macros, Funções, Fórmulas, Blog, Apostilas, Dicas, Boletins, 5.000 Planilhas Modelos)http://www.saberexcel.com/

Excel VBA Macros Planilhas Funcoes e ´Formulas
Loto - extrai seis números aleatórios10 de Julho, 2008
‘Esta macro extrai 6 números aleatórios somente ate 49

Sub Loto()
Dim i, choice, bolas(49)
For i = 1 To 49
bolas(i) = i
Next
Randomize Timer
For i = 1 To 6
choice = 1 + Int((Rnd * (49 - i)))
ActiveCell.Offset(0, i - 1).Value = bolas(choice)
bolas(choice) = bolas(50 - i)
Next
End Sub
‘—‘
Site das Macros Excel VBA
( 15.000 Macros, Funções, Fórmulas, Blog, Apostilas, Dicas, Boletins, 5.000 Planilhas Modelos)
http://www.saberexcel.com/