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.

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 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 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 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.