Blog Archive

About Me

A minha foto
JRod - PORTUGAL
Microsoft [MVP] - Excel (10º ano consecutivo)
Ver o meu perfil completo
Com tecnologia do Blogger.

Seguidores

Estatisticas

Free Blog Counter

eXTReMe Tracker
2004-12-31
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:
2004-12-28
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".

2004-12-27
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):
2004-12-26
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!
2004-12-20
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
2004-12-19
Em 16 deste mês, coloquei um post onde mostrei um exemplo
de uma fórmula para detectar valores duplicados em células.
Apresento agora um procedimento em VBE que apaga as linhas
onde se encontram os valores duplicados:


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)
2004-12-18
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
2004-12-16
Para encontrar valores duplicados, pode utilizar-se a seguinte fórmula, com as necessárias adaptações:

2004-12-15
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)
2004-12-14
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.
2004-12-13
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

2004-12-12
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

2004-12-11
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


2004-12-10
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

2004-12-09
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
2004-12-08
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

2004-12-07
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
2004-12-05
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:


2004-12-03
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:

2004-12-02
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):