Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Copiar dados utiliz...
 
Notifications
Clear all

Copiar dados utilizando mais de 2 campos como critérios

 
2024 - VBA & Macros
Post Recente por Roni Lupe 9 anos atrás
6 Posts
3 Usuários
0 Reactions
1,734 Visualizações
RSS
 Roni Lupe
(@roni-lupe)
Posts: 4
New Member
Topic starter
 

Olá pessoal!

Encontrei um exemplo de planilha que utiliza uma função em VBA para copiar dados de uma tabela para outra retornando somente os valores que atendem a um critério.

Veja:

Public Sub lsConsultaEstoque()

    Application.ScreenUpdating = False

    Worksheets("Consulta Estoque").Rows("10:500000").Select
    Selection.Delete Shift:=xlUp
    If Range("A3") = "Todos" Then
    Worksheets("Registro de Inventário").Range("A1:J1048576").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("A8:J8"), Unique:=False
    Else
    Worksheets("Registro de Inventário").Range("A1:J1048576").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
        "A2:A3"), CopyToRange:=Range("A8:J8"), Unique:=False
    End If
    lsRedimensionarTabela
    
    Application.ScreenUpdating = True

Gostaria de saber se é possível adaptar esse código para atender 4 campos como critérios?

Desde já, obrigado!

 
Postado : 23/06/2015 2:36 pm
 ezrey
(@ezrey)
Posts: 4
New Member
 

É possível fazer isso alterando ou incluindo mais critérios na condicional oferecida:

Onde colocou "If Range("A3") = "Todos"" é possível adicionar " And " ou até mesmo " ElseIf " que são condicionais adicionais para o procedimento que quer criar

Exemplo:

If Range("A3") = "Todos" And Range("B3") = "FORNECEDOR_X" And Range("D5").Value > 100 Then

Adicionando condicionais para um fornecedor específico e um valor maior que R$ 100,00

Tudo bem que alguns aprimoramentos poderiam ser feitos na planilha que deseja usar e no próprio If, como:
CCur (para convereter em $) ou até mesmo .Cells(#, #) ao invés de Range("')
Mas por hora pra isso que vc quer já dá !

Qualquer coisa entra em contato para dar uma melhorada
Abraço, espero ter ajudado !

 
Postado : 23/06/2015 6:15 pm
 Roni Lupe
(@roni-lupe)
Posts: 4
New Member
Topic starter
 

Olá ezrey!

Obrigado pela atenção!

Acho que não coloquei claramente o que pretendia. O que preciso é adicionar mais opção na seguinte parte do código:

"...CriteriaRange:=Range( _
"A2:A3")..."

Acrescentar os campos "B2:B3", "C2:C3" e "D2:D3".

 
Postado : 24/06/2015 6:02 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Roni, pode-se utilizar a opção de "Fields", mas não compreendi direito o que pretende, uma vez que os rotulos de "A2 até D3" não constam na aba "Registro de Inventário" de onde estão sendo buscado os dados a serem filtrados. Para podermos utilizar Filtros os rotulos têm de coincidir.

[]s

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 24/06/2015 7:21 pm
 Roni Lupe
(@roni-lupe)
Posts: 4
New Member
Topic starter
 

Olá, Mauro!

Me desculpe pela confusão.

O exemplo que postei de A2 até D3 não tem nada a ver com o exemplo de estoque.

Na verdade o que pretendo é adaptar o código a outra planilha que estou elaborando, em anexo. Portanto, o que eu preciso é inserir nos critérios as células: "I2:I3","J2:J3",K2:K3" e "L2:L3".

Obrigado!

 
Postado : 25/06/2015 6:15 am
 Roni Lupe
(@roni-lupe)
Posts: 4
New Member
Topic starter
 

Olá pessoal!

Consegui atingir o resultado desejado com uma pequena adaptação no código, conforme abaixo:

Public Sub lsConsultaCtrV4Info()

    
    Application.ScreenUpdating = False

    Worksheets("Consulta Contratos").Rows("10:500000").Select
    Selection.Delete Shift:=xlUp
    If Range("I3") = "TODOS" And Range("J3") = "TODOS" And Range("K3") = "TODAS" And Range("L3") = "TODOS" And Range("M3") = "TODAS" Then
    Worksheets("Lista Contratos").Range("B8:L1048576").AdvancedFilter Action:=xlFilterCopy, CopyToRange:=Range("B8:L8"), Unique:=False
    Else
    Worksheets("Lista Contratos").Range("B8:L1048576").AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Range( _
    "I2:I3", Range("J2:J3", Range("K2:K3", Range("L2:L3", Range("M2:M3"))))), CopyToRange:=Range("B8:L8"), Unique:=False
    End If
    
    lsRedimenTabCtrV
    
End Sub

A principio era pra ter 4 campos como critérios, mas acrescentei o campo safra (M2:M3).

Funcionou perfeitamente.

Obrigado!

 
Postado : 29/06/2015 2:52 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico