Saberexcel - o site das macros
Essas macros do Aplicativo Microsoft Excel VBA, deletam números pares ou impares, incluí na planilha uma macro para copiar os números de 1 a 100 para facilitar o seu teste. Espero que o exemplo possa lhe ser útil. Fiique com Deus, E_Marcondes.

Deleta números pares
Sub Deletar_numeros_pares()
For i = 1 To [A1].CurrentRegion.Rows.Count
For j = 1 To Cells(i, 1).CurrentRegion.Columns.Count
If Cells(i, j).Value Mod 2 = 0 Then
Cells(i, j).Delete xlToLeft
End If
Next
Next
End Sub

'Deleta números ímpares
'Observe que aqui usamos a mesma macro, porém, mudamos o nome e a atribuição
'do Operador Mod 1 (impares) Operador Mod 2 (pares)
Sub Deletar_numeros_impares()
For i = 1 To [A1].CurrentRegion.Rows.Count
For j = 1 To Cells(i, 1).CurrentRegion.Columns.Count
If Cells(i, j).Value Mod 1 = 0 Then
Cells(i, j).Delete xlToLeft
End If
Next
Next
End Sub

Esta é uma macro auxiliar que usei para copiar os números da Plan2 para a Plan2
Sub copiar_teste()
Sheets("Plan2").Range("A1:J10").Copy
Sheets("Plan1").Select
Range("A1").Select
ActiveSheet.Paste
Range("N1").Select
End Sub


Aprenda tudo sobre o Aplicativo Microsoft Excel VBA com Saberexcel

Baixe o exemplo de planilha contendo as macros acima
vba numeros por extenso ate 9999 (20.9 kB 2010-11-25 19:28:18)


Publicidade:
Compre com segurança, qualidade, garantia e preços baixos - Lojas SubMarino.

Saberexcel - o Site das Macros

Essa função e macro do Aplicativo Microsoft Excel VBA(Visual Basic Application), gera números aleatórios, fracionados e inteiros.


'GERA NUMEROS ALEATORIOS FRACIONADOS e inteiros

Function GERA_ENTRE_INTEIRO(Limite_inferior, Limite_superior)
GERA_ENTRE_INTEIRO = Int(Limite_inferior + Rnd() * (Limite_superior - Limite_inferior))
End Function

Function GERA_ENTRE(Limite_inferior, Limite_superior)
GERA_ENTRE = Limite_inferior + Rnd() * (Limite_superior - Limite_inferior)
End Function
'ex: '=GERA_ENTRE(0,60)

Sub gera_numeros_aleatorios_inteiro()
[G1:G100].FormulaR1C1 = "=GERA_ENTRE_INTEIRO(100,459)"
End Sub

Sub gera_numeros_aleatorios()
[G1:G100].FormulaR1C1 = "=GERA_ENTRE(100,459)"
End Sub


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

Saberexcel - o site de quem precisa Aprender Macros Microsoft Excel VBA.

Essas macros do Aplicativo Microsoft Excel VBA(Visual Basic Application), verifica se há um valor númerico na célula(B4), havendo um valor númerico, insere a palavra(PAGO), desloca duas células à direita(Propriedade Offset) e insere a palavra(Título Liquidado).
Observe que usei a condição IF, para facilitar o teste do usuário, quando voce clicar novamente com uma string(NÃO NUMÉRICO), a condição insere uma mensagem pedindo para que voce insira um valor númerico para realização do teste. Nesta movimentação oculta e ou mostra um shapes(autoforma) ligado a um macro. Espero que exemplo seja útil. Fique com Deus, Expedito Marcondes.

Observe a importância do aprendizado sobre as WorsheetFunctions, as funções de planilhas, não deixe de ver a matéria sobre,
300 Exemplo de Planilhas com as WorksheetFunctions (VBA) - Saberexcel
Excel planilha wkf worksheetfunction funções de planilhas retornam valores vba

Sub verifica_valor_numerico()
Dim iValor As Boolean

vCelula = [B4]
iValor = Application.WorksheetFunction.IsNumber(vCelula)

If iValor = True Then
[B4] = "PAGO"
[B4].Offset(0, 2).Value = "Titulo Liquidado" 'deslocando duas células a direita
Else
[B4].Offset(0, 2).Value = "Insira um valor(B4) para o teste" 'deslocando duas células a direita
ActiveSheet.Shapes("sby").Visible = True
End If
End Sub

Macro auxiliar para o teste do usuário, em todos os exemplos existentes, tentei facilitar no máximo o teste, com macros auxliares.
Sub insere_valor_numerico()
[B4].Value = "1456"
[B4].Offset(0, 2).Value = ""
MsgBox ("Valor númerico inserido, faça o teste"), vbInformation, "Saberexcel - site das macros"
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

Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções

Esse macro do aplicativo Microsoft Excel VBA, usando o objeto Dictionary, gera números aleatórios,
com o objetivo didatico há um incremento no macro para inserir cores aleatórias no interior das células na folha de planilhas
como também gerar cores da fonte da célula aleatórios.
Espero que gostem do exemplo de planilha que poderá baixá-la no final da página.
Fique com Deus, Expedito Marcondes

'//===='Escola Saberexcel VBA Estudos®
''//===='Treinamentos com Macros, Fórmulas e Funções
''''//===='Site: http://www.microsoftexcel.com.br
'''''//===='Email: [email protected]
''''''//===================================='

Sub numeros_aleatorios_grupos()
Dim Dicionario As Object
Range("A:A").Clear
d = 1

For i = 1 To 5
Set Dicionario = CreateObject("Scripting.Dictionary") leia sobre Objeto Dictionary
While Dicionario.Count < 5
Randomize
sbx = Int((1000 * Rnd)) + 1
Dicionario(sbx) = sbx
Wend
Cells(d, 1).Resize(Dicionario.Count) = Application.Transpose(Dicionario.keys)
Cells(d, 1).Resize(Dicionario.Count).Interior.ColorIndex = Int((56 * Rnd)) + 1
Cells(d, 1).Resize(Dicionario.Count).Font.ColorIndex = Int((56 * Rnd)) + 1
Cells(d, 1).Resize(Dicionario.Count).Font.Size = 8 'Int((16 * Rnd)) + 1
d = d + 6
Next i

[d12].Value = "Celula Interior Colorindex Bloco 1 = [ " & Cells(1, 1).Interior.ColorIndex & " ]"
[d13].Value = "Celula Font Colorindex Bloco 1 = [ " & Cells(1, 1).Font.ColorIndex & " ]"
[d14].Value = "'- - - - - -'"
[d15].Value = "Celula Interior Colorindex Bloco 2 = [ " & Cells(7, 1).Interior.ColorIndex & " ]"
[d16].Value = "Celula Font Colorindex Bloco 2 = [ " & Cells(7, 1).Font.ColorIndex & " ]"
[d17].Value = "'- - - - - -'"
[d18].Value = "Celula Interior Colorindex Bloco 3 = [ " & Cells(13, 1).Interior.ColorIndex & " ]"
[d19].Value = "Celula Font Colorindex Bloco 3 = [ " & Cells(13, 1).Font.ColorIndex & " ]"
[d20].Value = "'- - - - - -'"
[d21].Value = "Celula Interior Colorindex Bloco 4 = [ " & Cells(19, 1).Interior.ColorIndex & " ]"
[d22].Value = "Celula Font Colorindex Bloco 4 = [ " & Cells(19, 1).Font.ColorIndex & " ]"
[d23].Value = "'- - - - - -'"
[d24].Value = "Celula Interior Colorindex Bloco 5 = [ " & Cells(25, 1).Interior.ColorIndex & " ]"
[d25].Value = "Celula Font Colorindex Bloco 5 = [ " & Cells(25, 1).Font.ColorIndex & " ]"

[f12].Interior.ColorIndex = Cells(1, 1).Interior.ColorIndex
[f13].Interior.ColorIndex = Cells(1, 1).Font.ColorIndex
[f14].Value = "'- - - - - -'"
[f15].Interior.ColorIndex = Cells(7, 1).Interior.ColorIndex
[f16].Interior.ColorIndex = Cells(7, 1).Font.ColorIndex
[f17].Value = "'- - - - - -'"
[f18].Interior.ColorIndex = Cells(13, 1).Interior.ColorIndex
[f19].Interior.ColorIndex = Cells(13, 1).Font.ColorIndex
[f20].Value = "'- - - - - -'"
[f21].Interior.ColorIndex = Cells(19, 1).Interior.ColorIndex
[f22].Interior.ColorIndex = Cells(19, 1).Font.ColorIndex
[f23].Value = "'- - - - - -'"
[f24].Interior.ColorIndex = Cells(25, 1).Interior.ColorIndex
[f25].Interior.ColorIndex = Cells(25, 1).Font.ColorIndex
End Sub


Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.





: <<< Registre-se em nosso Site >>> acesse area para registrados.

Saberexcel o site das Macros
Essa Função do Aplicativo Microsoft Excel VBA, insere números por extenso até 9.999

Function Escr(n)
Unid = Array("", "Um", "Dois", "Três", "Quatro", "Cinco", _
"Seis", "Sete", "Oito", "Nove", "Dez", "Onze", "Doze", _
"Treze", "Quatorze", "Quinze", "Dezesseis", "Dezessete", _
"Dezoito", "Dezenove", "Vinte")
Dezen = Array("", "Dez", "Vinte", "Trinta", "Quarenta", _
"Cinquenta", "Sessenta", "Setenta", "Oitenta", "Noventa")
Centen = Array("", "Cento", "Duzentos", "Trezentos", _
"Quatrocentos", "Quinhentos", "Seiscentos", _
"Setecentos", "Oitocentos", "Novecentos", "Mil")
Num = n
Escr = ""
If n = 0 Then
Escr = "Zero"
End If
If (n \ 1000) > 0 And n \ 1000 < 10 Then
Escr = Unid(n \ 1000) & " Mil "
End If
n = n - (n \ 1000) * 1000
If n > 100 Then
Escr = Escr & Centen(n \ 100)
End If
If n = 100 Then
Escr = Escr & " Cem"
GoTo Prossiga
End If
n = n - (n \ 100) * 100
If n >= 20 And n < 100 Then
Escr = Escr & " " & Dezen(n \ 10)
End If
If n > 0 And n < 20 Then
Escr = Escr & " " & Unid(n)
GoTo Prossiga
End If
n = n - (n \ 10) * 10
If n > 0 Then
Escr = Escr & " " & Unid(n)
End If
Prossiga:
If Num Mod 10 <> 0 Then
If InStr(1, Escr, "Vinte", 1) = 0 Then
If InStr(1, Escr, "Trinta", 1) = 0 Then
If InStr(1, Escr, "enta", 1) > 0 Then
Escr = Application.Substitute(Escr, "enta", "enta e ")
End If
End If
End If
End If
If Num Mod 10 <> 0 Then
If InStr(1, Escr, "Vinte", 1) > 0 Then
If InStr(1, Escr, "Trinta", 1) = 0 Then
If InStr(1, Escr, "enta", 1) = 0 Then
Escr = Application.Substitute(Escr, "Vinte", "Vinte e ")
End If
End If
End If
End If
If Num Mod 10 <> 0 Then
If InStr(1, Escr, "Vinte", 1) = 0 Then
If InStr(1, Escr, "Trinta", 1) > 0 Then
If InStr(1, Escr, "enta", 1) = 0 Then
Escr = Application.Substitute(Escr, "Trinta", "Trinta e ")
End If
End If
End If
End If
If Num Mod 100 <> 0 Then
If InStr(1, Escr, "ento", 1) > 0 Then
Escr = Application.Substitute(Escr, "Cento", "Cento e ")
End If
End If
If Num Mod 100 <> 0 Then
If InStr(1, Escr, "entos", 1) > 0 Then
Escr = Application.Substitute(Escr, "entos", "entos e ")
End If
End If
If Num Mod 1000 <> 0 Then
If (Num - (Num \ 1000) * 1000) <= 100 Then
If InStr(1, Escr, "Mil", 1) > 0 Then
Escr = Application.Substitute(Escr, "Mil", "Mil e ")
End If
End If
End If

End Function

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA com Saberexcel

Compre com segurança, garantia e ótimos preços nas lojas SubMarino