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):

Exemplo de procedimento para formatação de células a BOLD, se estas contiverem valores negativos:

Sub BoldNegative()
Sheets("Hard_Bill").SelectColumns("E:E").Select
On Error Resume Next
Call CheckCells(Selection.SpecialCells(xlConstants, 23))
Call CheckCells(Selection.SpecialCells(xlFormulas, 23))
Columns("H:H").Select
On Error Resume Next
Call CheckCells(Selection.SpecialCells(xlConstants, 23))
Call CheckCells(Selection.SpecialCells(xlFormulas, 23))
Range("a1").Select
End Sub

Sub CheckCells(CurrRange As Range)
For Each cell In CurrRange
If cell.Value <>
cell.Font.Bold = True
With cell.Interior.ColorIndex = 5.Pattern = xlSolid
End With
End If
If cell.Value >= 0 Then
cell.Font.Bold = False
Selection.Interior.ColorIndex = 0
End If
Next cell
End Sub

Mark Wielgus (www.automateexcel.com) noticiou a existência deste Blog.



Obrigado, Mark!

Exemplo de uma selecção total numa caixa de texto (TextBox):

Para ver numa célula quantos dias tem determinado mês, pode utilizar-se a seguinte fórmula:


=DAY(DATE(AG3;MONTH(DATEVALUE(AG4&"-"&AG3))+1;0))

Assumindo que A4=05-11-2004, que A3=25-11-2004 e que o x de B1 deve ser maior do que 5 e que A1 é maior do que A4 mas menor do que A3, para aparecer a mensagem "ALERTA", caso contrário aparece a mensagem "NADA", teremos:

Para desabilitar a utilização da tecla "ESCAPE", pode incluir-se no procedimento Auto_Open() o comando que produz aquele efeito:

Exemplo de um procedimento que efectua a eliminação de conteúdos duplicados e efectua a ordenação por ordem ascendente, já sem os registos duplicados:

Exemplo de código para formatar células:

Exemplo de formatação de células utilizando o VBE:

Utilização da Função N() como meio para adicionar um comentário dentro da própria fórmula:

A fórmula que se mostra, deduz de uma data (A1) outra data (B1) e apresenta a palavra "EXPIROU", se o número for superior a 365:

A célula B1 contém referência relativa à célula A2, ou seja a coordenada da coluna é relativa e a linha também;
A célula B2 contém referência absoluta à célula A2, ou seja, a coordenada da coluna é absoluta e a linha também;
A célula B3 contém referência mista à célula A2, ou seja, a coordenada da coluna é relativa e a linha é absoluta;
A célula B4 contém referência mista à célula A2, ou seja, a coordenada da coluna é absoluta e a linha é relativa.

NOTA: Quando se introduz ou edita uma fórmula, ao premir-se a tecla de função F4, alteram-se os tipos de referência do ponto de inserção que estiver mais próximo.

Então, perguntei ao John como poderíamos somar valores existentes nessa combinação de Ranges, sem que se adicionassem, por duas vezes, a intersecção das linhas com as colunas.
A resposta foi dada da seguinte maneira:

Como se pode verificar, a rotina, em primeiro lugar, efectua um loop através de todas as células, utilizando o método UNION, para obter o valor total (intersecção incluída).
Depois, efectua outro loop, igualmente através da totalidade das células, utilizando o método INTERSECT, para obter o valor total da intersecção.
Finalmente, subtrai a soma deste segundo loop à soma do primeiro, a fim de obter o valor total correcto.

Há uns dias atrás, John Mansfield (http://pdbook.com/index.php/excel/index/), mostrou como se podem combinar Ranges através do método UNION, como se pode ver no exemplo que se segue:

Esta fórmula, que usa uma função de data [Agora()], dá o número da semana actual, desde o início do ano:

Exemplo da função Dia.Semana() [WeekDay()]:

Fórmula para dar o número de semanas que faltam para o fim do ano: