Saberexcel - o site das macros

Estas funções do Aplicativo Microsoft Excel VBA, tem por finalidade retornar textos e ou numeros contidos em uma determinada célula,
Digamos que na celula(A1) você tem o seguinte dado: Saber8754 Excel2008Macros
Função usada : '=Retorna_Numeros(A1)
Retorna .......: '87542008

Função usada .....: =Retorna_Texto(A1)
Retorno .............: ExcelVBAMacros

----------------'
'Retorna somente texto ignorando números
'=Retorna_Texto(A1)

Function Retorna_Texto(Cell As Range) As String
Dim LenStr As Long
For LenStr = 1 To Len(Cell)
Select Case Asc(Mid(Cell, LenStr, 1))
Case 65 To 90
Retorna_Texto = Retorna_Texto & Mid(Cell, LenStr, 1)
Case 97 To 122
Retorna_Texto = Retorna_Texto & Mid(Cell, LenStr, 1)
End Select
Next
End Function


Esta função Retorna_numeros, retorna somente números, ignorando os textos:
'=Retorna_Numeros(A1)

Function Retorna_Numeros(Cell As Range) As Long
Dim Ret_Texto As Long
For Ret_Texto = 1 To Len(Cell)
Select Case Asc(Mid(Cell, Ret_Texto, 1))
Case 48 To 57
Retorna_Numeros = Retorna_Numeros & Mid(Cell, Ret_Texto, 1)
End Select
Next
End Function

'macro usada para selecionar o módulo VBE(Visual Basic Editor)
Sub ir_módulo()
SendKeys ("%{F11}")
End Sub

'Agrupando as folhas de planilhas
Sub Agrupar_Colunas()
Columns("F:L").Select
Selection.Columns.Group
Range("D1").Select
End Sub

Aprenda tudo sobre o Aplicativo Microsoft Excel VBA com 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
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 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