Atingir Meta em Excel é uma tarefa relativamente simples, vamos imaginar que você possui uma tabela em Excel e precisa saber o quanto precisa reduzir nos custos para ter uma margem maior de lucro, abaixo uma tabela bem simples e o que é necessário para atingir esta meta.
Primeiro vamos em Ferramentas - Atingir Meta
Vai abrir uma janela pedindo para você informar onde representará o lucro da venda (Definir célula), o percentual lucro desejado (Para o valor) e qual célula será a meta no nosso caso Custos(Alternando célula), clique em OK e a célula custo te mostrará o novo valor a ser atingido.
Atingir Meta - Excel
Atingir Meta em Excel é uma tarefa relativamente simples, vamos imaginar que você possui uma tabela em Excel e precisa saber o quanto precisa reduzir nos custos para ter uma margem maior de lucro, abaixo uma tabela bem simples e o que é necessário para atingir esta meta.
Primeiro vamos em Ferramentas - Atingir Meta
Vai abrir uma janela pedindo para você informar onde representará o lucro da venda (Definir célula), o percentual lucro desejado (Para o valor) e qual célula será a meta no nosso caso Custos(Alternando célula), clique em OK e a célula custo te mostrará o novo valor a ser atingido.
Primeiro vamos em Ferramentas - Atingir Meta
Vai abrir uma janela pedindo para você informar onde representará o lucro da venda (Definir célula), o percentual lucro desejado (Para o valor) e qual célula será a meta no nosso caso Custos(Alternando célula), clique em OK e a célula custo te mostrará o novo valor a ser atingido.
Auditoria de Fórmulas Excel
Muitas vezes você já deve ter visto isto no Excel, mas, nunca imaginou para que serviria certo?
Então vamos a uma breve explicação do que seria a AUDITORIA DE FÓRMULAS em Excel.
Imaginemos que você possui uma planilha que vai calcular valor de desconto, então, você tem na célula A1 o valor real, na B1 você quer que calcule o valor de desconto e este desconto esta na C1.
vamos lá !
100 5 5%
100 0
mas e se você arrasta para linhas de baixo?
se você não fixar na fórmula a coluna C1 irá acontecer um erro e para isso servirá a auditoria de fórmulas.
Deixe o erro acontecer para que possamos analisar.
Agora vá na célula B2 e clique em auditoria de fórmulas - rastrear precedentes e ele te mostrará onde está o erro, você estará solicitando ao Excel para pegar um valor vazio, com este recurso é muito simples corrigir um erro de fórmula.
Então vamos a uma breve explicação do que seria a AUDITORIA DE FÓRMULAS em Excel.
Imaginemos que você possui uma planilha que vai calcular valor de desconto, então, você tem na célula A1 o valor real, na B1 você quer que calcule o valor de desconto e este desconto esta na C1.
vamos lá !
100 5 5%
100 0
mas e se você arrasta para linhas de baixo?
se você não fixar na fórmula a coluna C1 irá acontecer um erro e para isso servirá a auditoria de fórmulas.
Deixe o erro acontecer para que possamos analisar.
Agora vá na célula B2 e clique em auditoria de fórmulas - rastrear precedentes e ele te mostrará onde está o erro, você estará solicitando ao Excel para pegar um valor vazio, com este recurso é muito simples corrigir um erro de fórmula.
Excluir Dados Duplicados
Excluir dados duplicados é bem simples também, a partir do Excel 2007 esta ferramenta está muito simples.
Selecione a coluna que será feita a verificação, clique em Dados, e Remover Dados Duplicados, irá abrir uma janela informando a coluna e solicitando a confirmção, clique em OK e pronto.
Selecione a coluna que será feita a verificação, clique em Dados, e Remover Dados Duplicados, irá abrir uma janela informando a coluna e solicitando a confirmção, clique em OK e pronto.
Evitando dados duplicados em Excel - Validação
Validar para que uma determinada coluna não aceite dados duplicados é muito simples, segue abaixo uma maneira bem rápida de se fazer.
Primeiro escolha a coluna que será aplicada essa validação, clique em Validação.
Será aberta uma caixa de mensagem com alguns critérios para validação no nosso caso vamos escolher o Personalizado em "Permitir"
No campo fórmula insira a está fórmula =CONT.SE(A$1:A$50;A1)=1
Na aba Alerta de erro, descreva a mensagem que o usuário irá receber caso já exista o dado digitado.
Primeiro escolha a coluna que será aplicada essa validação, clique em Validação.
Será aberta uma caixa de mensagem com alguns critérios para validação no nosso caso vamos escolher o Personalizado em "Permitir"
No campo fórmula insira a está fórmula =CONT.SE(A$1:A$50;A1)=1
Na aba Alerta de erro, descreva a mensagem que o usuário irá receber caso já exista o dado digitado.
Criando Funções em VBA - Datas
Dias corridos entre datas em VBA
Function DiasCorridosEntreDatas(DataInicial As Date, DataFinal As Date) As Long
DiasCorridosEntreDatas = (DataFinal - DataInicial)
End Function
Dias úteis entre datas em VBA
Function DiasUteisEntreDatas(DataInicial As Date, DataFinal As Date) As Double
Dim Idatas As Date
Dim i As Double
i = 0
For Idatas = DataInicial To DataFinal
If ÉDiaUtil(Idatas) Then i = i + 1
Next
DiasUteisEntreDatas = i
End Function
Dias corridos após dias úteis em VBA
Function DiasCorridosAposDiasUteis(Data As Date, DiasUteis As Long) As Long
DiasCorridosAposDiasUteis = DiasCorridosEntreDatas(Data, DataAposDiasUteis(Data, DiasUteis))
End Function
Dias úteis após dias corridos em VBA
Function DiasUteisAposDiasCorridos(Data As Date, DiasCorridos As Long) As Long
DiasUteisAposDiasCorridos = DiasUteisEntreDatas(Data, Data + DiasCorridos)
End Function
Data após dias corridos em VBA
Function DataAposDiasCorridos(Data As Date, dias As Long) As String
DataAposDiasCorridos = Data + dias
End Function
Data após dias úteis em VBA
Function DataAposDiasUteis(Data As Date, dias As Long)
Dim i As Long
Dim DataUtil As Date
i = 0
DataUtil = Data
Do While Abs(i) < Abs(dias)
If ÉDiaUtil(DataUtil) Then i = i + Sgn(dias)
DataUtil = DataUtil + Sgn(dias)
Loop
Do While Not ÉDiaUtil(DataUtil)
DataUtil = DataUtil + Sgn(dias + 0.5)
Loop
DataAposDiasUteis = DataUtil
End Function
Próximo dia Útil em VBA
Function ProximoDiaUtil(Data As Date) As Date
Dim DataUtil As Date
DataUtil = Data + 1
Do While Not ÉDiaUtil(DataUtil)
DataUtil = DataUtil + 1
Loop
ProximoDiaUtil = DataUtil
End Function
Primeiro dia útil do mês em VBA
Function PrimeiroDiaUtilMes(Data As Date) As Date
Dim PrimeiroDiaMes As Date
PrimeiroDiaMes = CDate("01/" & Str(Month(Data)) & Str(Year(Data)))
PrimeiroDiaUtilMes = IIf(ÉDiaUtil(PrimeiroDiaMes), _
PrimeiroDiaMes, ProximoDiaUtil(PrimeiroDiaMes))
End Function
Ultimo dia útil do mês em VBA
Function UltimoDiaUtilMes(Data As Date) As Date
Dim PrimeiroDiaMesSeguinte As Date
If Month(Data) < 12 Then
PrimeiroDiaMesSeguinte = PrimeiroDiaUtilMes(CDate("01/" _
& Str(Month(Data) + 1) & Str(Year(Data))))
Else
PrimeiroDiaMesSeguinte = PrimeiroDiaUtilMes(CDate("01/01" _
& Str(Year(Data) + 1)))
End If
UltimoDiaUtilMes = DataAposDiasUteis(PrimeiroDiaMesSeguinte, -1)
End Function
Função para saber se é fim de semana em VBA
Function ÉFimSemana(Data As Date) As Boolean
If WeekDay(Data, vbMonday) < 6 Then
ÉFimSemana = False
Else
ÉFimSemana = True
End If
End Function
Função para saber se é Sábado em VBA
Function ÉSábado(Data As Date) As Boolean
If WeekDay(Data) = 7 Then
ÉSábado = True
Else
ÉSábado = False
End If
End Function
Função para saber se é Domingo em VBA
Function ÉDomingo(Data As Date) As Boolean
If WeekDay(Data) = 1 Then
ÉDomingo = True
Else
ÉDomingo = False
End If
End Function
Função em VBA para saber se é dia útil
Function ÉDiaUtil(Data As Date) As Boolean
If Not ÉFeriado(Data) And Not ÉFimSemana(Data) And Not ÉPascoa(CDate(Data)) Then
ÉDiaUtil = True
Else
ÉDiaUtil = False
End If
End Function
Função em VBA para saber qual o dia da semana
Function DiaDaSemana(Data As Date) As String
Select Case WeekDay(Data, vbMonday)
Case 1
DiaDaSemana = "Segunda"
Case 2
DiaDaSemana = "Terça"
Case 3
DiaDaSemana = "Quarta"
Case 4
DiaDaSemana = "Quinta"
Case 5
DiaDaSemana = "Sexta"
Case 6
DiaDaSemana = "Sábado"
Case 7
DiaDaSemana = "Domingo"
End Select
End Function
Função em VBA para saber o nome do mês
Function NomedoMes(iMesAtual As Integer)
Dim sNomeMes As String
Select Case iMesAtual
Case 1
sNomeMes = "Janeiro"
Case 2
sNomeMes = "Fevereiro"
Case 3
sNomeMes = "Março"
Case 4
sNomeMes = "Abril"
Case 5
sNomeMes = "Maio"
Case 6
sNomeMes = "Junho"
Case 7
sNomeMes = "Julho"
Case 8
sNomeMes = "Agosto"
Case 9
sNomeMes = "Setembro"
Case 10
sNomeMes = "Outubro"
Case 11
sNomeMes = "Novembro"
Case 12
sNomeMes = "Dezembro"
End Select
NomedoMes = sNomeMes
End Function
Função em VBA para determinar os feriados, muito útil.
Function ÉFeriado(sbsDia) As Boolean
Dim kcont As Integer, stFer(8) As String
stFer(1) = "1/1"
stFer(2) = "21/4"
stFer(3) = "1/5"
stFer(4) = "7/9"
stFer(5) = "12/10"
stFer(6) = "2/11"
stFer(7) = "15/11"
stFer(8) = "25/12"
For kcont = 1 To 8
If Day(sbsDia) & "/" & Month(sbsDia) = stFer(kcont) Then
ÉFeriado = True
Exit Function
End If
Next kcont
End Function
Função em VBA para saber se é Pascoa
Function ÉPascoa(sbsPascoa As Single) As Boolean
Dim sn As Integer, sa, sb, sc, sd, se, sf, sg, sh, si, sk, sl, sm, sp, sq As Single
Dim sDia, sMes, sDiaCarnaval, sDiaCarn, sMesCarnaval As Single
Dim stDiadePascoa As String, sDiadePascoa As Single, sDiaCorpChr As Single
sn = Year(sbsPascoa)
sa = sn - Int(sn / 19) * 19
sb = Int(sn / 100)
sc = sn - sb * 100
sd = Int(sb / 4)
se = sb - sd * 4
sf = Int((sb + 8) / 25)
sg = Int((sb - sf + 1) / 3)
sh = (19 * sa + sb - sd - sg + 15) - Int((19 * sa + sb - sd - sg + 15) / 30) * 30
si = Int(sc / 4)
sk = sc - si * 4
sl = (32 + 2 * se + 2 * si - sh - sk) - Int((32 + 2 * se + 2 * si - sh - sk) / 7) * 7
sm = Int((sa + 11 * sh + 22 * sl) / 451)
sp = Int((sh + sl - 7 * sm + 114) / 31)
sq = sh + sl - 7 * sm + 114 - sp * 31
sDia = sq + 1 'Domingo de Páscoa
sMes = sp 'Mês da Páscoa
stDiadePascoa = sDia & "/" & sMes & "/" & sn
sDiadePascoa = Int(CDate(stDiadePascoa))
sDiaCarnaval = sDiadePascoa - 47
sDiaCarn = sDiadePascoa - 48
sDiaCorpChr = sDiadePascoa + 60
If Day(sbsPascoa) = sDia And Month(sbsPascoa) = sp Then
ÉPascoa = True
End If
If Day(sbsPascoa) = sDia - 2 And Month(sbsPascoa) = sp Then
ÉPascoa = True
'Paixão de Cristo
End If
If Day(sbsPascoa) = Day(sDiaCarnaval) And Month(sbsPascoa) = Month(sDiaCarnaval) Then
ÉPascoa = True
'Terça Feira de Carnaval
End If
If Day(sbsPascoa) = Day(sDiaCorpChr) And Month(sbsPascoa) = Month(sDiaCorpChr) Then
ÉPascoa = True
'Corpus Christi
End If
If Day(sbsPascoa) = Day(sDiaCarn) And Month(sbsPascoa) = Month(sDiaCarn) Then
ÉPascoa = True
'Segunda feira de Carnaval
End If
End Function
Função para saber que idade a pessoa tem em VBA
Function QueIdade(dn)
QueIdade = Int((Date - dn) / 365.25)
QueIdade = IIf(QueIdade < 1, Format(QueIdade, "# anos"), Format(QueIdade, "# anos"))
End Function
Function DiasCorridosEntreDatas(DataInicial As Date, DataFinal As Date) As Long
DiasCorridosEntreDatas = (DataFinal - DataInicial)
End Function
Dias úteis entre datas em VBA
Function DiasUteisEntreDatas(DataInicial As Date, DataFinal As Date) As Double
Dim Idatas As Date
Dim i As Double
i = 0
For Idatas = DataInicial To DataFinal
If ÉDiaUtil(Idatas) Then i = i + 1
Next
DiasUteisEntreDatas = i
End Function
Dias corridos após dias úteis em VBA
Function DiasCorridosAposDiasUteis(Data As Date, DiasUteis As Long) As Long
DiasCorridosAposDiasUteis = DiasCorridosEntreDatas(Data, DataAposDiasUteis(Data, DiasUteis))
End Function
Dias úteis após dias corridos em VBA
Function DiasUteisAposDiasCorridos(Data As Date, DiasCorridos As Long) As Long
DiasUteisAposDiasCorridos = DiasUteisEntreDatas(Data, Data + DiasCorridos)
End Function
Data após dias corridos em VBA
Function DataAposDiasCorridos(Data As Date, dias As Long) As String
DataAposDiasCorridos = Data + dias
End Function
Data após dias úteis em VBA
Function DataAposDiasUteis(Data As Date, dias As Long)
Dim i As Long
Dim DataUtil As Date
i = 0
DataUtil = Data
Do While Abs(i) < Abs(dias)
If ÉDiaUtil(DataUtil) Then i = i + Sgn(dias)
DataUtil = DataUtil + Sgn(dias)
Loop
Do While Not ÉDiaUtil(DataUtil)
DataUtil = DataUtil + Sgn(dias + 0.5)
Loop
DataAposDiasUteis = DataUtil
End Function
Próximo dia Útil em VBA
Function ProximoDiaUtil(Data As Date) As Date
Dim DataUtil As Date
DataUtil = Data + 1
Do While Not ÉDiaUtil(DataUtil)
DataUtil = DataUtil + 1
Loop
ProximoDiaUtil = DataUtil
End Function
Primeiro dia útil do mês em VBA
Function PrimeiroDiaUtilMes(Data As Date) As Date
Dim PrimeiroDiaMes As Date
PrimeiroDiaMes = CDate("01/" & Str(Month(Data)) & Str(Year(Data)))
PrimeiroDiaUtilMes = IIf(ÉDiaUtil(PrimeiroDiaMes), _
PrimeiroDiaMes, ProximoDiaUtil(PrimeiroDiaMes))
End Function
Ultimo dia útil do mês em VBA
Function UltimoDiaUtilMes(Data As Date) As Date
Dim PrimeiroDiaMesSeguinte As Date
If Month(Data) < 12 Then
PrimeiroDiaMesSeguinte = PrimeiroDiaUtilMes(CDate("01/" _
& Str(Month(Data) + 1) & Str(Year(Data))))
Else
PrimeiroDiaMesSeguinte = PrimeiroDiaUtilMes(CDate("01/01" _
& Str(Year(Data) + 1)))
End If
UltimoDiaUtilMes = DataAposDiasUteis(PrimeiroDiaMesSeguinte, -1)
End Function
Função para saber se é fim de semana em VBA
Function ÉFimSemana(Data As Date) As Boolean
If WeekDay(Data, vbMonday) < 6 Then
ÉFimSemana = False
Else
ÉFimSemana = True
End If
End Function
Função para saber se é Sábado em VBA
Function ÉSábado(Data As Date) As Boolean
If WeekDay(Data) = 7 Then
ÉSábado = True
Else
ÉSábado = False
End If
End Function
Função para saber se é Domingo em VBA
Function ÉDomingo(Data As Date) As Boolean
If WeekDay(Data) = 1 Then
ÉDomingo = True
Else
ÉDomingo = False
End If
End Function
Função em VBA para saber se é dia útil
Function ÉDiaUtil(Data As Date) As Boolean
If Not ÉFeriado(Data) And Not ÉFimSemana(Data) And Not ÉPascoa(CDate(Data)) Then
ÉDiaUtil = True
Else
ÉDiaUtil = False
End If
End Function
Função em VBA para saber qual o dia da semana
Function DiaDaSemana(Data As Date) As String
Select Case WeekDay(Data, vbMonday)
Case 1
DiaDaSemana = "Segunda"
Case 2
DiaDaSemana = "Terça"
Case 3
DiaDaSemana = "Quarta"
Case 4
DiaDaSemana = "Quinta"
Case 5
DiaDaSemana = "Sexta"
Case 6
DiaDaSemana = "Sábado"
Case 7
DiaDaSemana = "Domingo"
End Select
End Function
Função em VBA para saber o nome do mês
Function NomedoMes(iMesAtual As Integer)
Dim sNomeMes As String
Select Case iMesAtual
Case 1
sNomeMes = "Janeiro"
Case 2
sNomeMes = "Fevereiro"
Case 3
sNomeMes = "Março"
Case 4
sNomeMes = "Abril"
Case 5
sNomeMes = "Maio"
Case 6
sNomeMes = "Junho"
Case 7
sNomeMes = "Julho"
Case 8
sNomeMes = "Agosto"
Case 9
sNomeMes = "Setembro"
Case 10
sNomeMes = "Outubro"
Case 11
sNomeMes = "Novembro"
Case 12
sNomeMes = "Dezembro"
End Select
NomedoMes = sNomeMes
End Function
Função em VBA para determinar os feriados, muito útil.
Function ÉFeriado(sbsDia) As Boolean
Dim kcont As Integer, stFer(8) As String
stFer(1) = "1/1"
stFer(2) = "21/4"
stFer(3) = "1/5"
stFer(4) = "7/9"
stFer(5) = "12/10"
stFer(6) = "2/11"
stFer(7) = "15/11"
stFer(8) = "25/12"
For kcont = 1 To 8
If Day(sbsDia) & "/" & Month(sbsDia) = stFer(kcont) Then
ÉFeriado = True
Exit Function
End If
Next kcont
End Function
Função em VBA para saber se é Pascoa
Function ÉPascoa(sbsPascoa As Single) As Boolean
Dim sn As Integer, sa, sb, sc, sd, se, sf, sg, sh, si, sk, sl, sm, sp, sq As Single
Dim sDia, sMes, sDiaCarnaval, sDiaCarn, sMesCarnaval As Single
Dim stDiadePascoa As String, sDiadePascoa As Single, sDiaCorpChr As Single
sn = Year(sbsPascoa)
sa = sn - Int(sn / 19) * 19
sb = Int(sn / 100)
sc = sn - sb * 100
sd = Int(sb / 4)
se = sb - sd * 4
sf = Int((sb + 8) / 25)
sg = Int((sb - sf + 1) / 3)
sh = (19 * sa + sb - sd - sg + 15) - Int((19 * sa + sb - sd - sg + 15) / 30) * 30
si = Int(sc / 4)
sk = sc - si * 4
sl = (32 + 2 * se + 2 * si - sh - sk) - Int((32 + 2 * se + 2 * si - sh - sk) / 7) * 7
sm = Int((sa + 11 * sh + 22 * sl) / 451)
sp = Int((sh + sl - 7 * sm + 114) / 31)
sq = sh + sl - 7 * sm + 114 - sp * 31
sDia = sq + 1 'Domingo de Páscoa
sMes = sp 'Mês da Páscoa
stDiadePascoa = sDia & "/" & sMes & "/" & sn
sDiadePascoa = Int(CDate(stDiadePascoa))
sDiaCarnaval = sDiadePascoa - 47
sDiaCarn = sDiadePascoa - 48
sDiaCorpChr = sDiadePascoa + 60
If Day(sbsPascoa) = sDia And Month(sbsPascoa) = sp Then
ÉPascoa = True
End If
If Day(sbsPascoa) = sDia - 2 And Month(sbsPascoa) = sp Then
ÉPascoa = True
'Paixão de Cristo
End If
If Day(sbsPascoa) = Day(sDiaCarnaval) And Month(sbsPascoa) = Month(sDiaCarnaval) Then
ÉPascoa = True
'Terça Feira de Carnaval
End If
If Day(sbsPascoa) = Day(sDiaCorpChr) And Month(sbsPascoa) = Month(sDiaCorpChr) Then
ÉPascoa = True
'Corpus Christi
End If
If Day(sbsPascoa) = Day(sDiaCarn) And Month(sbsPascoa) = Month(sDiaCarn) Then
ÉPascoa = True
'Segunda feira de Carnaval
End If
End Function
Função para saber que idade a pessoa tem em VBA
Function QueIdade(dn)
QueIdade = Int((Date - dn) / 365.25)
QueIdade = IIf(QueIdade < 1, Format(QueIdade, "# anos"), Format(QueIdade, "# anos"))
End Function
Validando Datas com Excel
Validando células que irão receber datas de um intervalo de datas.
Exemplo
01/01/2011 a 31/12/2011
Selecione uma célula e digite a seguinte fórmula no campo de validação.
=OU(ÉTEXTO(A1);E(A1>=C1;A1<=D1))
Se for acionado qualquer intervalo de datas que não esteja no intervalo que você definiu a validação será acionada.
Validando Datas de um determinado mês
=MÊS(A1)=MÊS(HOJE())
Validando células para aceitar datas até 360 dias da data atual.
=E(A1>=HOJE();A1<=DATA(ANO(HOJE())+1;MÊS(HOJE());DIA(HOJE())))
Validando células que aceite somente alguns dias anteriores a data de hoje.
=HOJE()-A1<=10
Neste caso a célula aceitará até 10 dias da data indicada.
Bom acho que deu pra entender um pouquinho, mais para frente postarei outras formas de validação.
Exemplo
01/01/2011 a 31/12/2011
Selecione uma célula e digite a seguinte fórmula no campo de validação.
=OU(ÉTEXTO(A1);E(A1>=C1;A1<=D1))
Se for acionado qualquer intervalo de datas que não esteja no intervalo que você definiu a validação será acionada.
Validando Datas de um determinado mês
=MÊS(A1)=MÊS(HOJE())
Validando células para aceitar datas até 360 dias da data atual.
=E(A1>=HOJE();A1<=DATA(ANO(HOJE())+1;MÊS(HOJE());DIA(HOJE())))
Validando células que aceite somente alguns dias anteriores a data de hoje.
=HOJE()-A1<=10
Neste caso a célula aceitará até 10 dias da data indicada.
Bom acho que deu pra entender um pouquinho, mais para frente postarei outras formas de validação.
Modificar tamanho DropDown em VBA
Muitas vezes criamos uma validação em Excel e o campo DropDown fica pequeno, para isso podemos utilizar o VBA e resolver nossos problemas.
Para modificar o tamanho do campo validado nada melhor que utilizar o evento Selection
Change(), evento que é acionado sempre que selecionamos uma determinada célula.
No módulo privado EstaPasta_de_trabalho selecione o Workbook_SheetSelectionChange()
e insira o código abaixo;
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Const dFixedPos As Double = "0.2"
Const dFixWidth As Double = "12.0" '
Dim vld As Validation
Dim lDpdLine As Long
If Not prvTarget Is Nothing Then
If Not oDpd Is Nothing Then
If oDpd.Value = 0 Then
prvTarget.Value = vbNullString
Else
prvTarget.Value = Range(Mid(sFml1, 2)).Item(oDpd.Value)
End If
Set prvTarget = Nothing
End If
End If
On Error Resume Next
oDpd.Delete
sFml1 = vbNullString
Set oDpd = Nothing
On Error GoTo 0
If Target.Count > 1 Then
Set oDpd = Nothing
Exit Sub
End If
Set vld = Target.Validation
On Error GoTo Terminate
sFml1 = vld.Formula1
On Error GoTo 0
Set prvTarget = Target
lDpdLine = Plan1.Range(Mid(sFml1, 2)).Rows.Count
With Target
Set oDpd = ActiveSheet.DropDowns.Add( _
.Left - dFixedPos, _
.Top - dFixedPos, _
.Width + dFixWidth + dFixedPos * 2, _
.Height + dFixedPos * 2)
End With
With oDpd
.ListFillRange = sFml1
.DropDownLines = lDpdLine
.Display3DShading = True
End With
Terminate:
End Sub
Para modificar o tamanho do campo validado nada melhor que utilizar o evento Selection
Change(), evento que é acionado sempre que selecionamos uma determinada célula.
No módulo privado EstaPasta_de_trabalho selecione o Workbook_SheetSelectionChange()
e insira o código abaixo;
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Const dFixedPos As Double = "0.2"
Const dFixWidth As Double = "12.0" '
Dim vld As Validation
Dim lDpdLine As Long
If Not prvTarget Is Nothing Then
If Not oDpd Is Nothing Then
If oDpd.Value = 0 Then
prvTarget.Value = vbNullString
Else
prvTarget.Value = Range(Mid(sFml1, 2)).Item(oDpd.Value)
End If
Set prvTarget = Nothing
End If
End If
On Error Resume Next
oDpd.Delete
sFml1 = vbNullString
Set oDpd = Nothing
On Error GoTo 0
If Target.Count > 1 Then
Set oDpd = Nothing
Exit Sub
End If
Set vld = Target.Validation
On Error GoTo Terminate
sFml1 = vld.Formula1
On Error GoTo 0
Set prvTarget = Target
lDpdLine = Plan1.Range(Mid(sFml1, 2)).Rows.Count
With Target
Set oDpd = ActiveSheet.DropDowns.Add( _
.Left - dFixedPos, _
.Top - dFixedPos, _
.Width + dFixWidth + dFixedPos * 2, _
.Height + dFixedPos * 2)
End With
With oDpd
.ListFillRange = sFml1
.DropDownLines = lDpdLine
.Display3DShading = True
End With
Terminate:
End Sub
Localizando dados com For Each
Aqui vamos percorrer toda a coluna A para localizar um dado que esta na coluna C com o for each.
Sub localizar()
Dim i As Range
For Each i In Sheets("Plan1").Range("A1:A15000")
If i.Value = Sheets("Plan1").Range("C1") Then
i.Select
End If
Next
End Sub
codigo muito util para localizar datas no excel, visto que na coluna C1 você pode inserir uma fórmula =hoje(), e este códgo no workbookopen do VBA e sempre que você abrir a planilha de excel ele localizará a data.
Sub localizar()
Dim i As Range
For Each i In Sheets("Plan1").Range("A1:A15000")
If i.Value = Sheets("Plan1").Range("C1") Then
i.Select
End If
Next
End Sub
codigo muito util para localizar datas no excel, visto que na coluna C1 você pode inserir uma fórmula =hoje(), e este códgo no workbookopen do VBA e sempre que você abrir a planilha de excel ele localizará a data.
Assinar:
Postagens (Atom)