segunda-feira, maio 30, 2005

Dúvida levantada pelo Carlos

"Basta sermos simples para sermos ricos em nossos atos!" (E.S.P.)
----------

**********
Mensagem do Carlos:
"30 May 05, 08:06 - CARLOS: Eneias, HELP, tenho esta fórmula =DATADIF(G9;G10;"Y") & " ano (s), " & DATADIF(G9;G10;"YM") & " mês (es) e " & DATADIF(G9;G10;"MD") & " dia (s). " preciso somar os resultado do calculo no final"
**********

Carlos, crie tabela paralelas (as mesmas ficarão ocultas) onde constarão na primeira coluna somente o ano, na segunda somente o mês e na terceira somente o dia. No final de cada coluna faça a soma individual do ano, mês e dia usando o formato concatenado como na tua função.

Exemplo:

Para as datas, 12/1/1980 (célula A1) -30/5/2005 (célula B1) teríamos o resultado em "F1" de "25 ano (s), 4 mês (es) e 18 dia (s)".
Para as datas, 10/8/1982 (célula A2) -30/5/2005 (célula B2) teríamos o resultado em "F2" de "22 ano (s), 9 mês (es) e 20 dia (s)".

tendo os valores individuais (estas colunas ficariam ocultas):
25, 4, 18 - (ano - "C1", mês - "D1", e dia - "E1")
22, 9, 20 - (ano - "C2", mês - "D2", e dia - "E2")

somando:
"C1+C2"= 47 - "resultado em C3"
"D1+D2"= 13 - "resultado em D3"
"E1+E2" = 38 - "resultado em E3"

Em "F3" coloque esta função:
=C3&" ano (s), "&D3&" mês (es) e "& E3&" dia (s)"

Resultado:

47 ano (s), 13 mês (es) e 38 dia (s)

----------
"O potencial humano só é medido por intermédio dos atos!" (E.S.P.)

Dúvida levantada pelo Jairo Borges

"Basta sermos simples para sermos ricos em nossos atos!" (E.S.P.)
----------

**********
Mensagens do Jairo Borges:

"28 May 05, 17:36 -
JAIRO BORGES: INTERVALO DAS 24 HORAS, QUALQUER HORÁRIO COLOCADO NA PLANILHA,SOMENTE SOMAR O PERÍODO QUE ESTIVER ENTRE AS 22 HORAS E AS 05 HORAS."

"28 May 05, 17:34 -
JAIRO BORGES: ESTOU COM UM PROBLEMA EM UMA PLANILHA DE FOLHA DE PONTO ONDE SÃO CALCULADAS AS HORAS TRABALHADAS. QUERO CALCULAR O ADICIONAL NOTURNO QUE É DAS 22 HORAS ÀS 05 HORAS DA MANHÃ; OU SEJA DENTRO DO INTERVAL"

**********

Coloque em "A1" a função:
=HOJE()

Coloque em "B1" a função:
=HOJE()+1

Coloque em "A2" a hora de entrada, exemplo:
23:10:45

Coloque em "B2" a hora de saída, exemplo:
06:01:00

Coloque em "A3" a função (preferível usar o formato "[hh]:mm:ss"):
=TEXTO(A1+SE(A2>=0,916666666666667;A2;0,916666666666667);"dd/mm/aaaa hh:mm:ss")

Coloque em "B3" a função (preferível usar o formato "[hh]:mm:ss"):
=TEXTO((HOJE()+1)+SE(B2<=0,208333333333333;B2;0,208333333333333);"dd/mm/aaaa hh:mm:ss")

As funções nas células "A3" e "B3" resultarão respectivamente os formatos:
30/05/2005 23:10:45
31/05/2005 05:00:00

Coloque em "C3" a função (preferível usar o formato "[hh]:mm:ss"):
=(TEXTO((HOJE()+1)+SE(B2<=0,208333333333333;B2;0,208333333333333);"dd/mm/aaaa hh:mm:ss"))-(TEXTO(A1+SE(A2>=0,916666666666667;A2;0,916666666666667);"dd/mm/aaaa hh:mm:ss"))
Essa função considerando horário noturno entre: 22:00:00 e 05:00:00.

Bem, na fórmula que foi colocada na célula "C3", significa que teremos apenas o resultado após a hora 22:00:00 e antes da hora 05:00:00.


----------
Maiores esclarecimentos, acesse o link que está no título deste post !

quarta-feira, maio 25, 2005

Função SE Matricial com Intervalo de dados

"Basta sermos simples para sermos ricos em nossos atos!" (E.S.P.)
----------


=SE((B1>=31)*(B1<=180);0,1;SE((B1>=181)*(B1<=360);0,12;SE(B1>=361;0,15)))

Mas antes de finalizar, use "CTRL + SHIFT + ENTER", pois trata-se de função matricial, ficando assim:

{=SE((B1>=31)*(B1<=180);0,1;SE((B1>=181)*(B1<=360);0,12;SE(B1>=361;0,15)))}

----------
Maiores esclarecimentos, acesse o link que está no título deste post !

terça-feira, maio 17, 2005

"Valor K-ésimo" - Função matricial

"Basta sermos simples para sermos ricos em nossos atos!" (E.S.P.)
----------

=MENOR((A1:A7);{2;3})

Finalize com "CTRL + SHIFT + ENTER".
Resultará:

{=MENOR((A1:A7);{2;3})}

----------
Maiores esclarecimentos, acesse o link que está no título deste post !

"Cont.se" com dois critérios - Função Matricial

"Basta sermos simples para sermos ricos em nossos atos!" (E.S.P.)
----------

Supondo que temos o intervalo "A1:A7" com valores de 1 a 7 respectivamente.
Por intermédio de função matricial poderemos contar um intervalo com dois critérios:

{=CONT.SE(A1:A7;1)+CONT.SE(A1:A7;3)}

Nesse exemplo, temos como resultado a contagem dos valores iguais a 1 e 3.

********
Sempre antes de finalizar a função matricial, usar "CTRL + SHIFT + ENTER".

----------
"O potencial humano só é medido por intermédio dos atos!" (E.S.P.)

Contar a cor do preenchimento

"Basta sermos simples para sermos ricos em nossos atos!" (E.S.P.)
----------

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
'Autor: Eneias dos Santos Pedroso
'
Dim i As Object
Dim Intervalo As Range
Set Intervalo = Range("A1:C10")
'Intervalo onde estão as células na cor vermelha
For Each i In Intervalo
If CorFundo(i) = 3 Then ' [ 3 ]= Vermelho
qtde = qtde + 1
End If
Next i
[D1] = qtde
'Célula que receberá a informação de quantas repetições houve
End Sub

Function CorFundo(vRange As Range)
If Selection.Areas.Count = 1 Then
CorFundo = vRange.Interior.ColorIndex
Else
CorFundo = Null
End If
End Function

----------
Maiores esclarecimentos, acesse o link que está no título deste post !

sábado, maio 14, 2005

Duas dicas sobre funções Matriciais

"Basta sermos simples para sermos ricos em nossos atos!" (E.S.P.)
----------

Supondo que temos o intervalo "A1:A7" com valores de 1 a 7 respectivamente.
Por intermédio de funções matriciais poderemos contar um intervalo ou fazer cálculos com critérios:

{=SOMA((A1:A7>2)*(A1:A7<7))}

Nesse exemplo, temos como resultado a contagem dos valores maiores que 2 e menores que 7.

********

{=SOMA((A1:A7>2)*(A1:A7<7)*a1:a7)}

Nesse exemplo, temos como resultado a soma dos valores maiores que 2 e menores que 7.

********
Sempre antes de finalizar a função matricial, usar "CTRL + SHIFT + ENTER".

----------
"O potencial humano só é medido por intermédio dos atos!" (E.S.P.)

Transferência de dados para outra planilha

"Basta sermos simples para sermos ricos em nossos atos!" (E.S.P.)
----------

Private Sub Worksheet_Change(ByVal Target As Range)
'
'Autor: Eneias dos Santos Pedroso
'
If Target.Row = 1 Or Target.Row = 2 Then Exit Sub

For j = 0 To 4997
If Target.Column = 14 Then
If Worksheets(2).Cells(j + 4, 1) = "" Then
Worksheets(2).Cells(j + 4, 1) = Cells(Target.Row, Target.Column - 13)
Worksheets(2).Cells(j + 4, 2) = Cells(Target.Row, Target.Column - 12)
Worksheets(2).Cells(j + 4, 3) = Cells(Target.Row, Target.Column - 11)
Worksheets(2).Cells(j + 4, 4) = Cells(Target.Row, Target.Column - 10)
Worksheets(2).Cells(j + 4, 5) = Cells(Target.Row, Target.Column - 9)
Worksheets(2).Cells(j + 4, 6) = Cells(Target.Row, Target.Column - 8)
Worksheets(2).Cells(j + 4, 7) = Cells(Target.Row, Target.Column - 7)
Worksheets(2).Cells(j + 4, 8) = Cells(Target.Row, Target.Column - 6)
Worksheets(2).Cells(j + 4, 9) = Cells(Target.Row, Target.Column - 5)
Worksheets(2).Cells(j + 4, 10) = Cells(Target.Row, Target.Column - 4)
Worksheets(2).Cells(j + 4, 11) = Cells(Target.Row, Target.Column - 3)
Worksheets(2).Cells(j + 4, 12) = Cells(Target.Row, Target.Column - 2)
Worksheets(2).Cells(j + 4, 13) = Cells(Target.Row, Target.Column - 1)
Worksheets(2).Cells(j + 4, 14) = Cells(Target.Row, Target.Column)
Exit For
End If: End If: Next j

End Sub

----------
Maiores esclarecimentos, acesse o link que está no título deste post !

terça-feira, maio 10, 2005

Funções estatísticas com mais de 30 argumentos

"Basta sermos simples para sermos ricos em nossos atos!" (E.S.P.)
----------


Bem sabemos que há momentos que precisamos de uma função estatística com mais de 30 argumentos para referenciarmos células não adjacentes.

Neste exemplo para a função "SOMA" temos 270 argumentos:

=SOMA((A1;A2;A3;A4;A5;A6;A7;A8;A9;A10;A11;A12;A13;A14;
A15;A16;A17;A18;A19;A20;A21;A22;A23;A24;A25;A26;A27;A28;
A29;A30):(B1;B2;B3;B4;B5;B6;B7;B8;B9;B10;B11;B12;B13;B14;
B15;B16;B17;B18;B19;B20;B21;B22;B23;B24;B25;B26;B27;B28;
B29;B30):(C1;C2;C3;C4;C5;C6;C7;C8;C9;C10;C11;C12;C13;C14;
C15;C16;C17;C18;C19;C20;C21;C22;C23;C24;C25;C26;C27;C28;
C29;C30):(D1;D2;D3;D4;D5;D6;D7;D8;D9;D10;D11;D12;D13;D14;
D15;D16;D17;D18;D19;D20;D21;D22;D23;D24;D25;D26;D27;D28;
D29;D30):(E1;E2;E3;E4;E5;E6;E7;E8;E9;E10;E11;E12;E13;E14;
E15;E16;E17;E18;E19;E20;E21;E22;E23;E24;E25;E26;E27;E28;E29;
E30):(F1;F2;F3;F4;F5;F6;F7;F8;F9;F10;F11;F12;F13;F14;F15;F16;
F17;F18;F19;F20;F21;F22;F23;F24;F25;F26;F27;F28;F29;F30):(G1;
G2;G3;G4;G5;G6;G7;G8;G9;G10;G11;G12;G13;G14;G15;G16;G17;
G18;G19;G20;G21;G22;G23;G24;G25;G26;G27;G28;G29;G30):(H1;
H2;H3;H4;H5;H6;H7;H8;H9;H10;H11;H12;H13;H14;H15;H16;H17;
H18;H19;H20;H21;H22;H23;H24;H25;H26;H27;H28;H29;H30):(I1;
I2;I3;I4;I5;I6;I7;I8;I9;I10;I11;I12;I13;I14;I15;I16;I17;I18;I19;I20;I21;

I22;I23;I24;I25;I26;I27;I28;I29;I30))

Apenas uma observação:
Será necessário tirar os espaços que contém no final de cada linha antes de colar a função em uma célula (os espaços foram colocados devido à largura da página no blog).

----------
Maiores esclarecimentos, acesse o link que está no título deste post !

sábado, maio 07, 2005

Instrução "Private" com propriedade "Cells"

"Basta sermos simples para sermos ricos em nossos atos!" (E.S.P.)
----------

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Row = 1 Then Exit Sub
If Target.Column = 2 And Target = "DEPOSITADO" Then
If Worksheets(2).Cells(Target.Row, Target.Column - 1) = "" Then
Worksheets(2).Cells(Target.Row, Target.Column - 1) = Cells(Target.Row, Target.Column - 1)
Cells(Target.Row, Target.Column - 1).ClearContents
Target = "Ok"
End If: End If
End Sub

----------
Maiores esclarecimentos, acesse o link que está no título deste post !

sexta-feira, maio 06, 2005

Filtro avançado com planilha Travada

"Basta sermos simples para sermos ricos em nossos atos!" (E.S.P.)
----------


Sub FiltroAvançado()
Dim r As Range
Set r = Selection 'Selecionar o intervalo antes de filtrar
On Error GoTo ErrorHandler
r.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:= _
Range("D1:D3"), Unique:=False
'Altere o intervalo de critérios onde há "D1:D3"
ErrorHandler:Select Case Err.Number
Case 1004
MsgBox "Selecione o intervalo a ser filtrado!"
Case 0
Exit Sub
Case Else
MsgBox "Erro nº " & Err
End Select
End Sub

Sub MostrarDados()
Application.Run "'Filtro avançado com planilha travada.xls'!FiltroAvançado"
Range("A1").Select
'Para ativar a macro e mostrar os dados novamente, selecione o intervalo filtrado!
'Após o filtro já existirá uma seleção, mas deverá selecionar o intervalo novamente.
'Ou, se preferir... selecione uma única célula, execute o filtro
'avançado novamente e logo após selecione as colunas inteiras.
End Sub

----------
Maiores esclarecimentos, acesse o link que está no título deste post !

quinta-feira, maio 05, 2005

Função "SE" com 30 ou mais condições (argumentos)

"Basta sermos simples para sermos ricos em nossos atos!" (E.S.P.)
----------

=VALOR(SE(A1="";1;"")&SE(A2="";2;"")&SE(A3="";3;"")&SE(A4="";4;"")&SE(A5="";5;"")&SE(A6="";6;"")&SE(A7="";7;"")&SE(A8="";8;"")&SE(A9="";9;"")&SE(A10="";10;"")&SE(A11="";11;"")&SE(A12="";12;"")&SE(A13="";13;"")&SE(A14="";14;"")&SE(A15="";15;"")&SE(A16="";16;"")&SE(A17="";17;"")&SE(A18="";18;"")&SE(A19="";19;"")&SE(A20="";20;"")&SE(A21="";21;"")&SE(A22="";22;"")&SE(A23="";23;"")&SE(A24="";24;"")&SE(A25="";25;"")&SE(A26="";26;"")&SE(A27="";27;"")&SE(A28="";28;"")&SE(A29="";29;"")&SE(A30="";30;""))

----------
Maiores esclarecimentos, acesse o link que está no título deste post !

Encontrar valores não repetidos em um intervalo

"Basta sermos simples para sermos ricos em nossos atos!" (E.S.P.)
----------

Sub NãoRepetem()
'
'Autor: Eneias dos Santos Pedroso
'
For p = 1 To 4 '4 linhas
For q = 1 To 2 '2 colunas
n = Application.WorksheetFunction.CountIf([A1:B4], Cells(p, q))
'Onde há: [A1:B4], poderá mudar
If n = 1 Then MsgBox "O valor " & Cells(p, q) & " está em: " & Cells(p, q).Address
Next q: Next p
End Sub

----------
Maiores esclarecimentos, acesse o link que está no título deste post !

quarta-feira, maio 04, 2005

Função matricial - Contagem com dois critérios

"Basta sermos simples para sermos ricos em nossos atos!" (E.S.P.)
----------


Sendo o intervalo "A1:B9", um exemplo que contenha na coluna A os nomes dos alunos e na coluna B as suas respectivas notas, onde na função está sendo considerado a notas entre os valores // 2 e 4,9 //, a função em "B10" será:

{=SOMA(SE(B2:B9>=2;1)*SE(B2:B9<=4,9;1))}

Valores capturados diretamente nas células; estando em "C1" o valor menor (2) e em "D1" o valor maior (4,9), use esta função matricial:

{=SOMA(SE(B2:B9>=C1;1)*SE(B2:B9<=D1;1))}

----------
Maiores esclarecimentos, acesse o link que está no título deste post !

terça-feira, maio 03, 2005

Transferência de dados entre pastas, criando um histórico

"Basta sermos simples para sermos ricos em nossos atos!" (E.S.P.)
----------

Private Sub Worksheet_Change(ByVal Target As Range)
'
'Autor: Eneias dos Santos Pedroso
'
For Each Item In Target
If Target.Row = 1 Then Exit Sub
If Target.Column = 1 Then
For j = 0 To 100 'Aumentar o intervalo de linhas (onde há o 100)
If Item.Value <> "" Then
Windows("Nome da pasta com o histórico.xls").Activate
'Mude o nome da pasta acima
If Worksheets(1).Cells(j + 1, 1) = "" Then
Worksheets(1).Cells(j + 1, 1) = Item
Windows("Nome da pasta que recebe os dados.xls").Activate
'Mude o nome da pasta acima
Exit For
End If: End If: Next j: End If

If Target.Row = 1 Then Exit Sub
If Target.Column = 2 Then
For k = 0 To 100 'Aumentar o intervalo de linhas (onde há o 100)
If Item.Value <> "" Then
Windows("Nome da pasta com o histórico.xls").Activate
'Mude o nome da pasta acima
If Worksheets(1).Cells(k + 1, 2) = "" Then
Worksheets(1).Cells(k + 1, 2) = Item
Windows("Nome da pasta que recebe os dados.xls").Activate
'Mude o nome da pasta acima
Exit For
End If: End If: Next k: End If

If Target.Row = 1 Then Exit Sub
If Target.Column = 3 Then
For m = 0 To 100 'Aumentar o intervalo de linhas (onde há o 100)
If Item.Value <> "" Then
Windows("Nome da pasta com o histórico.xls").Activate
'Mude o nome da pasta acima
If Worksheets(1).Cells(m + 1, 3) = "" Then
Worksheets(1).Cells(m + 1, 3) = Item
Windows("Nome da pasta que recebe os dados.xls").Activate
'Mude o nome da pasta acima
Exit For
End If: End If: Next m: End If

If Target.Row = 1 Then Exit Sub
If Target.Column = 4 Then
For n = 0 To 100 'Aumentar o intervalo de linhas (onde há o 100)
If Item.Value <> "" Then
Windows("Nome da pasta com o histórico.xls").Activate
'Mude o nome da pasta acima
If Worksheets(1).Cells(n + 1, 4) = "" Then
Worksheets(1).Cells(n + 1, 4) = Item
Windows("Nome da pasta que recebe os dados.xls").Activate
'Mude o nome da pasta acima
Exit For
End If: End If: Next n: End If
Next Item

End Sub

----------
Maiores esclarecimentos, acesse o link que está no título deste post !

Mudar informação em célula diariamente (+1)

"Basta sermos simples para sermos ricos em nossos atos!" (E.S.P.)
----------

Private Sub Worksheet_Activate()
'
'Autor: Eneias dos Santos Pedroso
'
Dim MyDate
MyDate = #5/7/2005#
'Lembre-se, o formato aqui é mês, dia e ano.
'Para nossa compreensão, 07/05/2005
'Também o valor de MyDate poderia ser uma célula - exemplo:
'MyDate = [E1]
'Nessa célula coloque a data com o formato usual
[A1] = MyDate - Date
End Sub

----------
Maiores esclarecimentos, acesse o link que está no título deste post !

segunda-feira, maio 02, 2005

Desativar o comando 'Cancelar' ao fechar pasta de trabalho

"Basta sermos simples para sermos ricos em nossos atos!" (E.S.P.)
----------

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim NameWord, Msg, Style, Title, Response
NameWork = ActiveWorkbook.Name
Msg = "Deseja salvar as alterações feitas a '" & NameWork & "'?"
Style = vbYesNo + vbDefaultButton1
Title = "Atenção!"
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then
Salvar
Else
NãoSalvar
End If
End Sub

Sub NãoSalvar()
ThisWorkbook.Saved = True
End Sub

Sub Salvar()
ThisWorkbook.Save
End Sub

----------
Maiores esclarecimentos, acesse o link que está no título deste post !

Crie a sua própria data de forma personalizada

"Basta sermos simples para sermos ricos em nossos atos!" (E.S.P.)
----------

Pode-se criar datas com informações individuais:

Para os valores informados nas célula "A1", "B1" e "C1", coloque esta função na célula "D1":

=DATA.VALOR(A1&"/"&B1&"/"&C1)

Dica: para outras necessidades, poderá criar referências absolutas!

----------
Maiores esclarecimentos, acesse o link que está no título deste post !

Referência Absoluta com atalho no teclado

"Basta sermos simples para sermos ricos em nossos atos!" (E.S.P.)
----------

Para que as referências às células fiquem absolulas, o atalho do teclado é "F4" (selecione cada referência em separado).

----------
Maiores esclarecimentos, acesse o link que está no título deste post !

domingo, maio 01, 2005

Inserir linha automaticamente com cópia do Formato

"Basta sermos simples para sermos ricos em nossos atos!" (E.S.P.)
----------

Private Sub Worksheet_Change(ByVal Target As Range)
'
'Autor: Eneias dos Santos Pedroso
'
If Target.Column = 7 Then 'Coluna 7 - "G", mude...
Target.EntireRow.Select
Selection.Copy
Target.EntireRow.Offset(1).Select
Selection.Insert Shift:=xlDown
Cells(Target.Row, Target.Column).Select
Application.CutCopyMode = False
End If
End Sub

----------

Para a seleção da primeira célula na próxima linha:
______________________

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 7 Then
Target.EntireRow.Select
Selection.Copy
Target.EntireRow.Offset(1).Select
Selection.Insert Shift:=xlDown
Cells(Target.Row + 1, 1).Select
Application.CutCopyMode = False
End If
End Sub

----------
Maiores esclarecimentos, acesse o link que está no título deste post !

Classificação Crescente Simultânea

"Basta sermos simples para sermos ricos em nossos atos!" (E.S.P.)
----------

Private Sub Worksheet_Change(ByVal Target As Range)
'

'Autor: Eneias dos Santos Pedroso
'
If Target.Column = 1 Then 'Mude aqui a coluna
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
End If
End Sub

----------
Maiores esclarecimentos, acesse o link que está no título deste post !