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

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

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

Esses macros e funcoes personalizadas do Aplicativo MS Excel VBA(Visual Basic Application) retornam um número que esteja
concatenado com um Texto, multiplicando por uma determinado número em colunas especificas (Quantidade, preço etc..)
veja que o macro abaixo busca valores em (Strings) concatenadas e as multiplica por valores (quantidade) x preço)
baixe o exemplo de planiha para ver melhor (no final da página).
(Duvida do Riomar)

Sub chamando_funcao_via_vba()
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row 'i variavel para encontrar a linha
Cells(i, "F").Value = CDbl(Extrair_Numero(Cells(i, "c")) * Cells(i, "d")) 'cdbl (double se houver decimais)
Next i
End Sub

Function Extrair_Numero(vCell As Range)
Dim vContador As Long, l As Long
Dim vTexto As String
Dim vNum As String
vTexto = vCell
For vContador = Len(vTexto) To 1 Step -1
If IsNumeric(Mid(vTexto, vContador, 1)) Then
l = l + 1
vNum = Mid(vTexto, vContador, 1) & vNum
End If
If l = 1 Then vNum = CInt(Mid(vNum, 1, 1))
Next vContador
Extrair_Numero = CLng(vNum)
End Function

Sub Limpar_teste()
Range("F2:F" & Range("A65000").End(xlUp).Row).ClearContents
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.

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.