Esse procedimento do Aplicativo Microsoft Excel VBA, formata determinada célula se o número digita for menor que zero, insere uma cor de fundo e uma fonte azul.

Private Sub Worksheet_Change(ByVal Target As Range)
'verifica se é número ou string
If IsNumeric(Range("A1").Value) = False Then
MsgBox ("Valor digitado nao númerico"), vbInformation, "Saberexcel.com"
' Range("A2").Interior.ColorIndex = xlNone
Exit Sub
End If

'verifica se é número ou string
If IsNumeric(Range("A2").Value) = False Then
MsgBox ("Valor digitado nao númerico"), vbInformation, "Saberexcel.com"
Range("A2").Interior.ColorIndex = xlNone
Exit Sub
End If

'verifica se maior ou igual a zero
If Range("A1").Value >= 0 Then
Range("A1").Interior.ColorIndex = 35
Else
Range("A1").Interior.ColorIndex = xlNone
End If

'verifica se menor ou igual a zero
If Range("A2").Value <= 0 Then
Range("A2").Interior.ColorIndex = 45
Else
Range("A2").Interior.ColorIndex = xlNone
End If

End Sub


Aprenda tudo sobre Aplicativo Microsoft Excel VBA - SaberExcel

Saberexcel - o site das macros
Essa macro do Aplicativo Microsft Excel VBA, contém um estrutura lógica que faz um loop e procura valores maiores que 3 e menores que 9
na coluna (A) na range determinada (A1:A10), e os insere na coluna a e insere na coluna(B)

Sub procura_valores()
Dim i As Integer
Dim x As Single
Dim y As Single

For i = 1 To 10
x = Cells(i, 1)
If 3 < x And x < 9 Then
Cells(i, 2) = x
End If
Next i
End Sub

Sub limpar()
Range("b1:b20").ClearContents
End Sub


Aprenda tudo sobre Aplicativo Microsft Excel VBA - Saberexcel

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

Saberexcel - o site de quem precisa aprender macros
Essas macros do Aplicativo Microsoft Excel VBA, inverte a ordem de números de uma determinada coluna, observe que não é ordem descendente, é uma inversão de ordem, como pode ver na imagem abaixo, a posição dos números na ordem inversa. baixe a planilha exemplo no final da página.


'................'
Option Explicit
Option Base 1

Sub Inverter_Valores_Celulas()
Dim WkbBook As Workbook
Dim wsPlan As Worksheet
Dim rnDados As Range
Dim VlrDados As Variant, VlrTemp As Variant
Dim i As Long
On Error Resume Next
Set WkbBook = ActiveWorkbook
Set wsPlan = WkbBook.Worksheets("Inverter valores celula")

With wsPlan
Set rnDados = .Range(.Range("A2"), .Range("A65536").End(xlUp))
End With

VlrDados = rnDados.Value

For i = 1 To (UBound(VlrDados, 1) / 2)
VlrTemp = VlrDados(i, 1)
'Aqui para posições 1 a 9 na matriz» do último 9 valores a
'partir da matriz original.
VlrDados(i, 1) = VlrDados(UBound(VlrDados) - i + 1, 1) * 1
'Aqui para posições 10 a 18 na matriz» do 9 valores a
'partir da matriz original.
VlrDados(UBound(VlrDados) - i + 1, 1) = VlrTemp * 1

Next i

With wsPlan
.Range("B2:B" & UBound(VlrDados, 1) + 1).Value = VlrDados
End With

End Sub

Sub limpar()
Range("B2:B19").ClearContents
End Sub



Aprenda tudo sobre o Aplicativo Microsoft Excel VBA - Saberexcel

Publicidade
Compre com garantia, segurança e ótimos preços nas lojas submarino.

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.