EXCELer

Supondo que é dado o valor da Receita Líquida e que o valor do Fundo é o resultado da fórmula Receita Bruta*Taxa, como apurar o valor dessa Receita Bruta?



Uma possível resposta está no seguinte Código em VBE:

'---------------------------------------------------------------------------------------
' Procedure : CommandButton1_Click
' DateTime  : 31-12-2004 16:38
' Author    : Jorge Rodrigues
' Purpose   : Apuramento da Receita Bruta
'---------------------------------------------------------------------------------------
'
Private Sub CommandButton1_Click()
    Dim ValLiq, Tax, Cem, iBox

    Tax = 88
    Cem = 100
    ValLiq = Worksheets("Sheet1").Range("C5")
    If ValLiq = "" Then
        Exit Sub
    End If
    iBox = Range("C4")
    If iBox = "" Then
        iBox = 0
    End If

    ValBrut = (ValLiq - iBox) * Cem / Tax
    Range("C1").Select
    ActiveCell = ValBrut
End Sub


O resultado seria, no exemplo:

A fórmula que se apresenta adiciona as quantidades segundo um critério determinado (no exemplo, a quantidade correspondente a cada letra).
Como se trata de um Array, não esquecer de utilizar {}, através das teclas CTRL + Shift + Enter na fórmula activa.
De notar que o "*" aqui tem a função do operador "AND".

Para formatar uma célula como fracção (ex. 1/4), digita-se na célula 0 1/4 (ou seja: zero,espaço, um, slash, quatro):

Pode formatar-se texto numa célula activa, bastando, para isso, marcar o que se pretende
e, na barra de menus ir a Formatar>Células|Fonte
e escolher a Fonte, o Estilo, o Tamanho e a Cor.
O resultado será (exemplo):

Andrew Engwirda, autor do Blog sobre Excel: Andrew's Excel Tips tem o link deste Blog
mencionado ns sua coluna Excel Tips & Forums.
Obrigado, Andrew!

Até dia 26, não há nada pr'a ninguém... Por isso:

Exemplo de preenchimento de células com os valores contidos em Arrays:



Código:

Sub Preencher()
    Sheets("Sheet1").[A1:A5] = _
    WorksheetFunction.Transpose(Array(1, 2, 3, 4, 5))
    Sheets("Sheet1").[B1:B5] = _
    WorksheetFunction.Transpose(Array(6, 7, 8, 9, 10))
    Sheets("Sheet1").[C1:C5] = _
    WorksheetFunction.Transpose(Array(11, 12, 13, 14, 15))
End Sub

Se tivermos uma folha com valores e fórmulas e quisermos apagar apenas os valores, deixando ficar as fórmulas, como no exemplo a seguir:



podemos utilizar o seguinte Código:

Private Sub CommandButton1_Click()
    On Error Resume Next
    Cells.SpecialCells(xlCellTypeConstants, xlNumbers).ClearContents
End Sub

Sub RemoveDuplicates()
Worksheets("Sheet1").Range("A2").Sort key1:=Worksheets("Sheet1").Range("A1")
Set currentCell = Worksheets("Sheet1").Range("A1")
Do While Not IsEmpty(currentCell)
Set nextCell = currentCell.Offset(1, 0)
If nextCell.Value = currentCell.Value Then
currentCell.EntireRow.Delete
End If
Set currentCell = nextCell
Loop
End Sub

Exemplo da utilização da Função SUM()
para somar a célula A1 das folhas 1 a 3:


Fórmula na Sheet4:

=Sum(Sheet1:Sheet3!A1)

Exemplo de fórmula que pesquisa um número numa célula mediante um dado parâmetro
com vista a atribuir um certo valor à nova célula:



Fórmula em C1:
=IF(ISNUMBER(A1);IF(OR(INT(A1/1000)=17;INT(A1/1000)=18;INT(A1/1000)=19);100;IF(INT(A1/1000)>=50;50;25));"")

Private Sub IblMail_Click()
Link = "mailto:jorgerod2@sapo.pt"
    On Error GoTo NoCanDo
    ActiveWorkbook.FollowHyperlink Address:=Link, NewWindow:=True
    Unload Me
    Exit Sub
NoCanDo:
    MsgBox "Impossível Abrir " & Link
End Sub

Para encontrar valores duplicados, pode utilizar-se a seguinte fórmula, com as necessárias adaptações:

Exemplos de teclas de atalho: CTRL + 0 (zero) CTRL + 9:


CTRL + 0 - esconde a(s) coluna(s) activa(s)
CTRL + 9 - esconde a(s) linha(s) activa(s)

Exemplos de teclas de atalho - CTRL + R :

Esta tecla de atalho copia o conteúdo e o formato da primeira célula do Range. No exemplo, o Range é A1:D1, mas se o que quiséssemos copiar fosse o conteúdo de A1 e A2, marcaríamos o Range A1:D2 e usávamos o shortcut mencionado.

Exemplos de teclas de atalho - CTRL + D:

Esta tecla de atalho copia o conteúdo e o formato da primeira célula do Range. No exemplo, o Range é C1:c5, mas se o que quiséssemos copiar fosse o conteúdo de C1 e D1, marcaríamos o Range C1:D5 e usávamos o shortcut mencionado.

Teclas de atalho (exemplos):

A Função RptSpace() devolve um número de espaços entre cadeias de caracteres:


Código:

Public Function RptSpace(ByVal strNum As Variant) As String
Dim strOut As String

strOut = Space(strNum)
RptSpace = strOut

End Function

A Função RptChar(), devolve o caracter digitado o número de vezes pretendido:



Código:

Public Function RptChar(ByVal strNum As String, _
ByVal intChar As String) As String
Dim strOut As String

strOut = String(strNum, intChar)
RptChar = strOut

End Function

A Função dhRoman(123) ou, no exemplo, dhRoman(A1) retorna CXXIII:



Código:

Public Function dhRoman(ByVal intValue As Integer) As String

' Converte um numero decimal entre 1 and 3999
' em numeração romana.

' A partir de "VBA Developer's Handbook, 2nd Edition"
' por Ken Getz and Mike Gilbert
' Copyright 2001; Sybex, Inc. All rights reserved.

' Exemplo:
' dhRoman(123) retorna "CXXIII"

Dim varDigits As Variant
Dim lngPos As Integer
Dim intDigit As Integer
Dim strTemp As String

varDigits = Array("I", "V", "X", "L", "C", "D", "M")
lngPos = LBound(varDigits)
strTemp = ""
Do While intValue > 0
intDigit = intValue Mod 10
intValue = intValue \ 10
Select Case intDigit
Case 1
strTemp = varDigits(lngPos) & strTemp
Case 2
strTemp = varDigits(lngPos) & _
varDigits(lngPos) & strTemp
Case 3
strTemp = varDigits(lngPos) & _
varDigits(lngPos) & varDigits(lngPos) & strTemp
Case 4
strTemp = varDigits(lngPos) & _
varDigits(lngPos + 1) & strTemp
Case 5
strTemp = varDigits(lngPos + 1) & strTemp
Case 6
strTemp = varDigits(lngPos + 1) & _
varDigits(lngPos) & strTemp
Case 7
strTemp = varDigits(lngPos + 1) & _
varDigits(lngPos) & varDigits(lngPos) & strTemp
Case 8
strTemp = varDigits(lngPos + 1) & _
varDigits(lngPos) & varDigits(lngPos) & _
varDigits(lngPos) & strTemp
Case 9
strTemp = varDigits(lngPos) & _
varDigits(lngPos + 2) & strTemp
End Select
lngPos = lngPos + 2
Loop
dhRoman = strTemp
End Function

Se limitarmos o comprimento da String de output, por exemplo para 11 dígitos, o nome sai truncado:


Código do exemplo:


Sub NameWidth()
Dim Name As String * 11 ' O caracter "* NN" indica o número máximo de
' dígitos pretendido para a String

Name = InputBox("Digite o seu Nome")
Range("A1") = Name
Name = InputBox("Digite o seu Nome")
Range("A2") = Name

End Sub

Utilização de um formulário para identificar as células que contêm valores negativos:



Exemplo de Código:


Sub test1()
Dim arr()
Dim zero
zero = 0
Set rng = Sheets(1).Range("A1:A5")
k = Application.CountIf(Range(rng(1), rng(5)), "<0")
ReDim arr(1 To k)
j = 1
For i = 1 To rng.Count
If rng(i).Value < color="#00007f">Then
arr(j) = rng(i).Address(False, False) & " " & rng(i).Value
j = j + 1
End If
Next
UserForm1.ListBox1.List = arr
UserForm1.Show
End Sub

Ao clicar-se no Botão de comando,



aparece o resultado em C1, que é a soma de B1:B10:



O Código em VBE, é:

Private Sub CommandButton1_Click()
Dim myRange As Range
Dim Var1 As Long

Set myRange = Worksheets("Sheet1").Range("B1:B10")
Var1 = Application.WorksheetFunction.Sum(myRange)
Range("C1") = Var1
End Sub

Se a célula A3 for igual a SIM, então A2 diminui 1 unidade:



Private Sub CommandButton1_Click()
Dim Val
Val = Range("A2").Value
If Range("A3") = "SIM" Then
Val = Val - 1
Range("A2") = Val
End If
End Sub

Se quisermos executar um determinado procedimento ciclicamente (p.ex. ao fim de cada 5 minutos passados), podemos utilizar o seguinte:

Sub Auto_Open()
Call Teste
End Sub

Public Sub Teste()
Dim msg
msg = MsgBox("Isto é um Teste")
Application.OnTime Now + TimeValue("00:05:00"), "Teste"
End Sub

Em 27 de Novembro passado, apresentei uma fórmula para ver numa célula quantos dias tem determinado mês. Mostro agora uma nova fórmula, simplificada, descrita por John Mansfield -
http://pdbook.com/index.php/excel/index/ -que dá o mesmo resultado:

O conjunto de algarismos inseridos na caixa de texto do formulário, aparecem alterados na sua formatação na célula "A1":

Private Sub CommandButton1_Click() ' Botão "ENVIA"
Range("A1") = TextBox1.Text
Unload Me
End Sub

Private Sub TextBox1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
If Not IsNumeric(TextBox1) Or Len(TextBox1) > 10 Then Cancel = True
Me.TextBox1.Text = Format(TextBox1, "000-000-0000")
End Sub

A Função CONTAR.VAZIO() [COUNTBLANK()] conta as células vazias num determinado Range:

Exemplo de fórmula que dá o valor resultante da aplicação de uma percentagem. Neste exemplo se a percentagem a aplicar a A1 for 10 (B1), então o valor resultante é 3 (C1). De notar a inclusão do símbolo % na própria fórmula:

Exemplo de procedimento para adicionar 12 folhas ao Workbook, com os nomes dos meses:

O indicador RANDOMIZE inicia o gerador aleatório de números (neste exemplo gera 6 números entre 1 e 49):