Notifications
Clear all

Adicionar mais um criterio de filtro

15 Posts
2 Usuários
0 Reactions
2,802 Visualizações
(@maxgomes)
Posts: 16
Active Member
Topic starter
 

Boa tarde!
Eu tenho um codigo aqui do forum e eu queria inserir mais um criterio no filtro
Codigo:

Sub CopyData()
'   Declaração de variaveis
Dim shREPORT As Worksheet, shSOURCE As Worksheet
Dim dDate As Date, iData As Date
Dim strNAME(2) As String
Dim i As Long, r As Long, n As Long, b As Byte, Bim As Long
'   Definição das datas
Set shREPORT = ThisWorkbook.Worksheets("Relatório")
Bim = shREPORT.Range("C5").Value
dDate = CDate(shREPORT.Range("G8"))
iData = CDate(shREPORT.Range("F8"))
'   Definição das planilhas
Select Case Bim

Case 1
    strNAME(0) = "Fevereiro"
    strNAME(1) = "Março"
    strNAME(2) = "Abril"
Case 2
    strNAME(0) = "Abril"
    strNAME(1) = "Maio"
    strNAME(2) = "Junho"
Case 3
    strNAME(0) = "Agosto"
    strNAME(1) = "Setembro"
    strNAME(2) = "Outubro"
Case 4
    strNAME(0) = "Outubro"
    strNAME(1) = "Novembro"
    strNAME(2) = "Dezembro"
End Select


r = 11
For b = 0 To 2
    Set shSOURCE = ThisWorkbook.Worksheets(strNAME(b))
    With shSOURCE
        n = .Cells.SpecialCells(xlCellTypeLastCell).Row
        For i = 2 To n
                If CDate(.Cells(i, 1)) >= iData And .Cells(i, 1) <= dDate And .Cells(i, 1) <> "" Then
                    .Rows(i).Copy Destination:=shREPORT.Rows(r)
                    r = r + 1
                End If
        Next
    End With
Next
End Sub

Como podem ver, ele recebe o valor da celula C5, G8 e F8.
Eu preciso receber tambem o valor da G5!

Se alguem puder me ajudar...
Obrigado!

 
Postado : 15/02/2012 1:54 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

maxGomes, obter o valor de uma celula para uma variavel é relativamente simples; no exemplo, de um nome a variavel; nValor por exemplo;
nValor= shreport("G5").value
Porem o mais importante: Que dado ou valor se espera obter em G5, e essa "variavel" é suposta a fazer oque.

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

 
Postado : 15/02/2012 2:13 pm
(@maxgomes)
Posts: 16
Active Member
Topic starter
 

Eu quero filtrar os valores: Manha, Tarde e Noite
Somente para separar os tres

 
Postado : 15/02/2012 2:31 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Creio que poderia ficar assim:

Sub CopyData()
'   Declaração de variaveis
Dim shREPORT As Worksheet, shSOURCE As Worksheet
Dim dDate As Date, iData As Date
Dim strNAME(2) As String, Periodo As String
Dim i As Long, r As Long, n As Long, b As Byte, Bim As Long
'   Definição das datas
Set shREPORT = ThisWorkbook.Worksheets("Relatório")
Bim = shREPORT.Range("B5").Value
dDate = CDate(shREPORT.Range("G8"))
iData = CDate(shREPORT.Range("F8"))
Periodo = shREPORT.Range("G5").Value
'   Definição das planilhas
Select Case Bim
Case 1
    strNAME(0) = "Fevereiro"
    strNAME(1) = "Março"
    strNAME(2) = "Abril"
Case 2
    strNAME(0) = "Abril"
    strNAME(1) = "Maio"
    strNAME(2) = "Junho"
Case 3
    strNAME(0) = "Agosto"
    strNAME(1) = "Setembro"
    strNAME(2) = "Outubro"
Case 4
    strNAME(0) = "Outubro"
    strNAME(1) = "Novembro"
    strNAME(2) = "Dezembro"
End Select

r = 11
For b = 0 To 2
    Set shSOURCE = ThisWorkbook.Worksheets(strNAME(b))
    With shSOURCE
        n = .Cells.SpecialCells(xlCellTypeLastCell).Row
        For i = 2 To n
                If CDate(.Cells(i, 1)) >= iData And .Cells(i, 1) <= dDate _
                And .Cells(i, 1) <> "" And Periodo = .cels(i, 2) Then
                    .Rows(i).Copy Destination:=shREPORT.Rows(r)
                    r = r + 1
                End If
        Next
    End With
Next
End Sub

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

 
Postado : 15/02/2012 2:42 pm
(@maxgomes)
Posts: 16
Active Member
Topic starter
 

ta dando erro na linha
Set shSOURCE = ThisWorkbook.Worksheets(strNAME(b))

 
Postado : 15/02/2012 4:30 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

max,

só - "ta dando erro na linha", é um pouco vago, ajudaria se postasse qual a mensagem de erro, como não temos esta informação, vou arriscar um palpite que seja o seguinte erro :

Erro em tempo de execução '9':
Subscrito fora do intervalo

Se for, é porque não temos a aba referenciada na variavel : (strNAME(b)), explicando, se o valor em C5 for 2, então é armazenado na variável acima a condição do Case 2:
Case 2
strNAME(0) = "Abril"
strNAME(1) = "Maio"
strNAME(2) = "Junho"

ou seja, na variavel "strNAME(b))" como temos o Loop, na instrução :
Set shSOURCE = ThisWorkbook.Worksheets(strNAME(b))
(strNAME(b)) será igual as abas "Abril, Maio e Junho", sendo assim se as abas não existirem, teremos o erro.

Isto é o que eu estou supondo, se não for, favor detalhar melhor a mensagem do erro.

[]s

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

 
Postado : 15/02/2012 6:07 pm
(@maxgomes)
Posts: 16
Active Member
Topic starter
 

Mauro, desculpe por nao ter colocado direito oq tava acontecendo...
mas o erro é este mesmo que voce falou....
Estranho, as abas existem, estao todas la...mas mesmo assim continua o erro!

 
Postado : 15/02/2012 6:27 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

masGomes
No codigo que passei tem um erro grafico -->Periodo = .cels(i, 2) Then, deve ser .cells....

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

 
Postado : 15/02/2012 6:33 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

De fato Reinaldo, eu havia corrigido no teste que fiz e não postei, falha minha, apesar de isto não se relacionar ao erro que o mesmo reportou que seria de a aba não existir.

Max, verifique se os nomes das abas estão corretas, não conteem espaço ou outro caracter diferente, acrescente a a linha da msgbox para ser exibido os nomes armazenados na variavel :
................
For b = 0 To 2
MsgBox strNAME(b)
..........................

[]s

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

 
Postado : 15/02/2012 6:40 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Mauro vc tem toda a razão, aparentemente o erro é o apontado por ti.

contudo é estranho, visto que sem o acrescimo do periodo como uma variavel, estava funcionando (pelo menos foi dito que sim).

por isso postei a planilha onde fiz o teste, e o codigo roda sem retornar erro.

maxGomes, se persistir, envie a planilha para que possamos "depura-la"

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

 
Postado : 15/02/2012 6:55 pm
(@maxgomes)
Posts: 16
Active Member
Topic starter
 

Verifiquei as abas e os nomes estao iguais aos que estao no codigo.
E na msgbox, nao aparece nome nenhum...acho qe nao esta armazenando as abas na variavel, é isso?
segue a planilha

 
Postado : 15/02/2012 7:03 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

O erro é que você copiou a rotina que o Reinaldo postou e não ajustou o range, ou seja :

Bim = shREPORT.Range("B5").Value

E em sua planilha a variavel é referente a "C5"

[]s

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

 
Postado : 15/02/2012 7:10 pm
(@maxgomes)
Posts: 16
Active Member
Topic starter
 

Eu tinha feito as correcoes de celula...
ate pq, as 4 variaveis mudaram de lugar, do codigo que o Reinaldo me passou..
a msg box esta aparecendo o nome das abas...agora soh nao esta copiando...

 
Postado : 15/02/2012 7:16 pm
Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Max, fiz algumas alterações na rotina, troque por esta :

Sub CopyDataMauro()
    '   Declaração de variaveis
    Dim shREPORT As Worksheet, shSOURCE As Worksheet
    Dim dDate As Date, iData As Date
    Dim strNAME(2) As String, Periodo As String
    Dim i As Long, r As Long, n As Long, b As Byte, Bim As Long
    
    '   Definição das datas
    Set shREPORT = ThisWorkbook.Worksheets("Relatório")
    Bim = shREPORT.Range("C5").Value
    dDate = CDate(shREPORT.Range("F8"))
    iData = CDate(shREPORT.Range("G8"))
    Periodo = shREPORT.Range("G5").Value
    '   Definição das planilhas

    Select Case Bim
        Case 1
            strNAME(0) = "Fevereiro"
            strNAME(1) = "Março"
            strNAME(2) = "Abril"
        Case 2
            strNAME(0) = "Abril"
            strNAME(1) = "Maio"
            strNAME(2) = "Junho"
        Case 3
            strNAME(0) = "Agosto"
            strNAME(1) = "Setembro"
            strNAME(2) = "Outubro"
        Case 4
            strNAME(0) = "Outubro"
            strNAME(1) = "Novembro"
            strNAME(2) = "Dezembro"
        End Select
    
        r = 11
        
        For b = 0 To 2
            Set shSOURCE = ThisWorkbook.Worksheets(strNAME(b))
            With shSOURCE
                'Contamos a qde de itens na Coluna A
                n = shSOURCE.Range("A" & Rows.Count).End(xlUp).Row
                
                For i = 2 To n
                        
                        While CDate(.Cells(i, 1)) >= dDate And .Cells(i, 1) <= iData _
                                And .Cells(i, 1) <> "" And Periodo = .Cells(i, 2)
                            
                            .Rows(i).Copy Destination:=shREPORT.Rows(r)
                            
                            i = i + 1
                            r = r + 1
                        Wend
                Next
                
            End With
            
        Next

End Sub

Não realizei varios testes, então qq coisa retorne.

[]s

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

 
Postado : 15/02/2012 8:29 pm
(@maxgomes)
Posts: 16
Active Member
Topic starter
 

Deu certinho Mauro! muito obrigado! pelos testes que eu fiz até agora, ta tudo ok! valeu mesmo! E obrigado ao Reinaldo também!

 
Postado : 16/02/2012 2:17 pm