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 !

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 !

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 !

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 !