Execução de ciclos

[vostrikov]

Bom dia a todos,

Gostaria de solicitar ajudar com um problema que eu tenho. Sou novo nesta andanças e so me falta o ciclo if para por o codigo todo a funcionar.

Estou a criar um module em VBA no excel, abaixo irei colocar o codigo com o intuito de alguem me poder ajudar.

A minha ideia foi criar um filtro e pesquisar data repetidas e quando ela estiverem repetidas ele copias para a folha 2. utilizei uma inputbox para solicitar a data a pesquisar, mas o ciclo que eu nao consegui ainda fazer foi caso a data introduzida nao for igual à data que se encontra na coluna seleccionada pedir uma data valida. ele iria repetir o ciclo enquanto a data for diferente.

Codigo que eu criei sem ciclo if

Sub FiltrarECopiar()
Dim Msg As String
'Limpar o conteudo da folha desde A2 ate k1000
    With Sheets("Folha2")
        .Range("A2:K1000").Clear
        Selection.ClearContents
    End With
'Selecciona a folha 1
Sheets("Folha1").Select
'Introduzo a data a ser pesquisada
Msg = InputBox(" Escreva Data de Entrega")
Msg = UCase(Msg)
'Vai pesquisar o o valor contido em Msg com a coluna 3
Range("C3").AutoFilter Field:=3, Criteria1:=Msg
'copia o conteudo de A3 ate k200 para a folha 2
Folha1.Range("A3:k200").Copy Destination:=Folha2.Range("A2")
ActiveSheet.ShowAllData
End Sub

Codigo criado com o ciclo if que me dá erro.
Sub FiltrarECopiar()
Dim Msg As String
Dim i As Integer
Dim ultLin As Integer
Dim Ops(1 To 3) As String
    Ops(1) = Day(Date)
    Ops(2) = Month(Date)
    Ops(3) = Year(Date)
    Msg = Ops(1) & "-" & Ops(2) & "-" & Ops(3)

    Sheets("Folha1").Select
    Application.Cursor = xlNormal
    ActiveCell.FormulaR1C1 = InputBox(Prompt:="Colocar Data (dd-mm-aaaa):", _
                                      Title:="Date", Default:=Msg)

'ultLin = Folha1.Cells(Rows.Count, "C").End(xlUp).Row

    With Sheets("Folha2")
        .Range("A2:K1000").Clear
        Selection.ClearContents
    End With

Sheets("Folha1").Select
Msg = InputBox(" Escreva Data de Entrega")
Msg = UCase(Msg)

For i = 3 To 100
    If Msg = Folha1.Cells(i, 3) Then
        
        Range("C3").AutoFilter Field:=3, Criteria1:=Msg
        Folha1.Range("A3:k200").Copy Destination:=Folha2.Range("A2")
        ActiveSheet.ShowAllData
        
    Else
        Msg = InputBox(" Escreva nova Data de Entrega")
        Msg = UCase(Msg)
            
    End If

Next i

End Sub

Não sei se o codigo esta com as variaveis bem declaradas.

Se houver alguem que me possa ajudar agradeço.

Cumprimentos,

[edmolko]

Boas!

Em primeiro lugar não existem ciclos if, há ciclos (for, while, etc...) e if é uma verificação de condição.

Em vez de utilizares o ciclo for, utiliza o "Do while":

Dim dataValida as boolean = false

do while not dataValida

Msg = InputBox(" Escreva Data de Entrega")
Msg = UCase(Msg)

dataValida = DataIsValida(Msg)

loop

Tens de implementar a função para verificares se a data é válida:

function DataIsValida(byval Msg as string) as boolean

[vostrikov]

boas,

obrigado por teres respondido e obrigado pela correcção

estou a experimentar colocar o codigo como sugeriste mas o Dim dataValida as boolean = false, dá erro

experimentei substituir o ciclo for pelo do while not dataValida mas da-me erro dataIsvalida(Msg)

como crio a function DataIsValida(byval Msg as string) as boolean, como aplico isso no codigo.

Como disse eu sou um novato nisto se me puderes ajudar agradeço-te imenso,

estou a utilizar isto no excel.

Cumprimentos.

[edmolko]

Desculpa, esqueci-me que em vba não podes declarar uma variável e atribuir um valor na mesma linha, ao contrário de VB.NET

Tens que fazer em linhas separadas:

Dim dataValida as boolean 
dataValida = false

experimentei substituir o ciclo for pelo do while not dataValida mas da-me erro dataIsvalida(Msg)

Dá erro porque não criaste a função, já alguma vez criaste uma function ou uma sub?

[vostrikov]

Estou hoje a começar a criar isto que estas a ver.

Quando eu disse que era novo nisto nao estava a brincar. Ainda nao sei bem o que é uma sub ou uma function ainda estou a tentar perceber isto tudo, se me puderes ajudar agradeço-te.

Obrigado e Cumprimentos,

[jpaulino]

Vê se este artigo ajuda: http://www.jorgepaulino.com/2009/10/excel-dicas-de-vba-ciclos.html

[vostrikov]

Peço desculpa por estar a maçar outra vez,

Sub FiltrarECopiar()
Dim Msg As String
'Limpar o conteudo da folha desde A2 ate k1000
   With Sheets("Folha2")
        .Range("A2:K1000").Clear
        Selection.ClearContents
    End With
'Selecciona a folha 1
Sheets("Folha1").Select
'Introduzo a data a ser pesquisada
Msg = InputBox(" Escreva Data de Entrega")
Msg = UCase(Msg)
'Vai pesquisar o o valor contido em Msg com a coluna 3
Range("C3").AutoFilter Field:=3, Criteria1:=Msg
'copia o conteudo de A3 ate k200 para a folha 2
Folha1.Range("A3:k200").Copy Destination:=Folha2.Range("A2")
ActiveSheet.ShowAllData
End Sub

Este codigo funciona perfeitamente, o unico senao é se eu me enganar a introduzir a data.

baseando-me no link do jpaulino tentei chegar a um ciclo com uma comparação que funciona-se, mas infelizmente este ultimo nao funciona.

Sub FiltrarECopiar()
Dim Msg As String
Dim x As Integer
Dim lastRow As Long

        lastRow = Cells(Cells.Rows.Count, "c").End(xlUp).Row

    With Sheets("Folha2")
        .Range("A2:K1000").Clear
        Selection.ClearContents
    End With

Sheets("Folha1").Select
Msg = InputBox(" Escreva Data de Entrega")
Msg = UCase(Msg)

For x = 3 To lastRow
     If Len(Folha1.Cells(x, "C").Value) = Msg Then
            
        Range("C3").AutoFilter Field:=3, Criteria1:=Msg
        Folha1.Range("A3:k200").Copy Destination:=Folha2.Range("A2")
        ActiveSheet.ShowAllData
    Exit For
    
    Else
        Msg = InputBox(" Escreva nova Data de Entrega")
        Msg = UCase(Msg)
    Exit For
    End If

Next x

End Sub

será que alguem me pode ajudar??

Para quem tem experiencia isto nao é nada, mas para quem é novo como eu, que começou a mexer nisto hoje, está a ser complicado.

Obrigado e desculpem lá

Cumprimentos

[FreiNando]

Realmente é confuso.

1 - Tens de nos explicar o que queres fazer.

2- No ciclo que fizeste queres introduzir uma data e copiar os dados filtrados por essa data.

    Não entendo porque comparas o numero de caracteres de uma celula com a data.

    Na pratica essa comparação é sempre falsa. A não ser que introduzas uma data lá para o ano 1900.

    Sendo falsa a comparação pedes a introdução de uma data e sais do ciclo.

    Significa que esse ciclo só é executado uma vez!

3- A Inputbox devolve o texto que for escrito quando carregas ok, caso contrario devolve "".

    Para saberes se esse texto pode ser convertido para data usa IsDate(Texto).

    Para converter para data DateValue(Texto).

4- Cada folha do Excel tem duas propriedades Name:

    Uma (Name) que é o nome interno da folha e não pode conter espaços nem caracteres especiais, e podes aceder à folha Assim: Folha1

    Outra Name que é o nome da folha que aparece no separador do Livro e acedes por Worksheets("Folha1")

    Os dois podem ser diferentes!

    Podes ainda Utilizar o numero de indice das folhas: Worksheetes(1)

    Sheets inclui folhas e gráficos.

Por te querer ajudar a iniciar na programação, não de te vou dar código nenhum. Gostava de ver como o vais refazer.

[vostrikov]

Realmente sei que é confuso.

Vou tentar explicar o que pretendo de umja forma clara. Eu queria copiar as datas repetidas para uma segunda folha. Neste caso o campo chave seria as datas de entrega, quando corro o codigo ele pede-me a data quando eu introduzo a data correcta ele copia as os dados que eu escolhi para a segunda folha. Mas quando eu corro novamente o codigo e introduzo uma data que nao se encontra na coluna datas de entrega, por esta nao esxistir ou por eu me ter enganado a introduzi-la, eu queria que aparece-se  a janela a pedir que colocasse uma nova data de entrega por esta ultima estar errada. basicamente era so isto que eu queria fazer. Espero que esta explicação tenha sido melhor.

eu vou tentar Fazer o que me estas a dizer. Não quer dizer que consiga, mas vou tentar. e apresentar-te-ei uma solução.

Se me poderes recomendar um livro em que eu possa aprender visual basic para excel agradeço-te, e se poder consultar-te para verificar o codigo agradeço-te.

Cumprimentos,

Realmente é confuso.

1 - Tens de nos explicar o que queres fazer.

2- No ciclo que fizeste queres introduzir uma data e copiar os dados filtrados por essa data.

    Não entendo porque comparas o numero de caracteres de uma celula com a data.

    Na pratica essa comparação é sempre falsa. A não ser que introduzas uma data lá para o ano 1900.

    Sendo falsa a comparação pedes a introdução de uma data e sais do ciclo.

    Significa que esse ciclo só é executado uma vez!

3- A Inputbox devolve o texto que for escrito quando carregas ok, caso contrario devolve "".

    Para saberes se esse texto pode ser convertido para data usa IsDate(Texto).

    Para converter para data DateValue(Texto).

4- Cada folha do Excel tem duas propriedades Name:

    Uma (Name) que é o nome interno da folha e não pode conter espaços nem caracteres especiais, e podes aceder à folha Assim: Folha1

    Outra Name que é o nome da folha que aparece no separador do Livro e acedes por Worksheets("Folha1")

    Os dois podem ser diferentes!

    Podes ainda Utilizar o numero de indice das folhas: Worksheetes(1)

    Sheets inclui folhas e gráficos.

Por te querer ajudar a iniciar na programação, não de te vou dar código nenhum. Gostava de ver como o vais refazer.

[FreiNando]

Vou tentar explicar o que pretendo de umja forma clara. Eu queria copiar as datas repetidas para uma segunda folha. Neste caso o campo chave seria as datas de entrega, quando corro o codigo ele pede-me a data quando eu introduzo a data correcta ele copia as os dados que eu escolhi para a segunda folha. Mas quando eu corro novamente o codigo e introduzo uma data que nao se encontra na coluna datas de entrega, por esta nao esxistir ou por eu me ter enganado a introduzi-la, eu queria que aparece-se  a janela a pedir que colocasse uma nova data de entrega por esta ultima estar errada. basicamente era so isto que eu queria fazer. Espero que esta explicação tenha sido melhor.

Isto é o que pretendes. Agora o que deves fazer:

1- Pedir ao utilizador uma data.

          a- Se a data for válida continuar.

          b- Se for inválida pedir outra.

          c- Se o utilizador não introduzir nada(cancelar) Sair.

2- Procurar linhas que contenham essa data. Obter a quantidade de linhas.

          a- Se não houver nenhuma, voltar ao ponto 1, ou sair.

          b- Se houver linhas, apagar a lista de destino e copiar a lista da pesquisa e Sair.

Quanto a livros, eu pessoalmente já não os uso, e os poucos que tenho têm mais de 15 anos e estão em inglês.

Mas a ajuda do Excel possui muitas informação. Usa a tecla F1.

[vostrikov]

Sub FiltrarECopiar()
Dim Msg As String

    With Sheets("Folha2")
        .Range("A2:K1000").Clear
        Selection.ClearContents
    End With

Worksheets("Folha1").Select
Msg = InputBox(" Escreva Data de Entrega")
Msg = UCase(Msg)
DateValue (Msg)

For i = 3 To 1000 Step 1
            
    If Msg = Worksheets("Folha1").Cells(i, "C") Then
        Range("C3").AutoFilter Field:=3, Criteria1:=Msg
        Folha1.Range("A3:k200").Copy Destination:=Folha2.Range("A2")
        ActiveSheet.ShowAllData
    Exit For
    Else
        Msg = InputBox(" Escreva Data de Entrega")
        Msg = UCase(Msg)
        DateValue (Msg)
    End If
Next i
End Sub

Este ciclo esta a trabalhar, mas não da forma que eu quero, vou tentar explicar.

A minha coluna que contem as datas, esta tudo desordenado, se eu colocar uma data que esteja na linha 100 ele vai-me sempre perguntar Escreva data de entrega pois ele esta a verificar linha a linha manualmente. Podes tentar dar-me mais uma luz.

Obrigado e desculpa lá

Cumprimentos.

[FreiNando]

Bom, eu fiz uns ajustes ao teu código:

Sub FiltrarECopiar()
    Dim D As Date, S As String, N As Long, Q As Long, W As Worksheet
    
    Do
        Set W = Worksheets("Folha1")
        'Introduzir a Data de Entrega
        Do
            S = InputBox(" Escreva Data de Entrega")
            If S = "" Then Exit Sub
        Loop Until IsDate(S)
        D = DateValue(S)
        
        'Obter a ultima linha usada
        N = W.Range("C1000").End(xlUp).Row
        'filtrar os dados pela coluna 3 da filtragem
        W.Range("C3").AutoFilter Field:=3, Criteria1:=D
        'Contar as linhas visiveis. Para evitar erro contar com o cabeçalho
        Q = W.Range("A1:A" & N).SpecialCells(xlCellTypeVisible).Count
        
        If Q > 1 Then
            'caso exista linhas copiar
            With Worksheets("Folha2")
            'Aqui podemos também determinar as celulas usadas para limpar o conteúdo
            .Range("A2:K1000").ClearContents
            W.Range("A3:K" & N).Copy Destination:=.Range("A2")
            W.Range("C3").AutoFilter 'Limpar os filtros
            End With
            Exit Sub
        Else
            'caso contrario perguntar se quer repetir a consulta
            W.Range("C3").AutoFilter 'Limpar os filtros
            If MsgBox("não tem registos nesta data" & vbCrLf _
                & "Escolher outra Data?", vbYesNo) = vbNo Then Exit Sub
        End If
    Loop
    
End Sub

Verifica se serve para o teu caso. Não sei qual o formato das celulas ou em que coluna começa o filtro, julgo ser na coluna A.

Peço que tentes compreender o ciclo de execução do meu código.

[vostrikov]

Boas,

Antes de mais, deste-me um nó grande em partes do codigo.

Experimentei o codigo na minha folha de excel e só nao esta a copiar.

Quero entender o codigo entao vou-te fazer perguntas sobre ele.

Porque colocastes aqui este Do?

Do
        Set W = Worksheets("Folha1")
        'Introduzir a Data de Entrega

Apartir do proximo Ponto foi onde eu me perdi, não percebi esse Q, como nao entendi esse If

        'Contar as linhas visiveis. Para evitar erro contar com o cabeçalho
        Q = W.Range("A1:A" & N).SpecialCells(xlCellTypeVisible).Count ' Nao percebi isto
        
        If Q > 1 Then
            'caso exista linhas copiar
            With Worksheets("Folha2")
            'Aqui podemos também determinar as celulas usadas para limpar o conteúdo
            .Range("A2:K1000").ClearContents
            W.Range("A3:K" & N).Copy Destination:=.Range("A2")
            W.Range("C3").AutoFilter 'Limpar os filtros
            End With
            Exit Sub
        Else
            'caso contrario perguntar se quer repetir a consulta
            W.Range("C3").AutoFilter 'Limpar os filtros
            If MsgBox("não tem registos nesta data" & vbCrLf _
                & "Escolher outra Data?", vbYesNo) = vbNo Then Exit Sub
        End If
    Loop

Posso-te enviar a folha de Excel para algum e-mail para que me possas ver??

Obrigado e Cumprimentos.

[FreiNando]

Caso queiras colocar o teu ficheiro, faz upload em algum site de partilha de ficheiros tipo SendSpace, depois de retirares ou substituires informações confidenciais, claro.

Esse Do é só para evitar usar Goto, que quanto a mim está mais que ultrapassado.

Ele faz com que o pedido de introdução de uma data seja repetido até serem encontradas linhas com essa data ou o utilizador cancelar.

Se não está a copiar, deves depurar o código usando o F8 para a execução ser efectuada passo a passo opu colocar breakpoints, e verificando o valor de cada variável.

W é uma referência à Folha1.

N indica o número da ultima linha com dados.

Q é para armazenar a quantidade de linhas da pesquisa +1(cabeçalho).

D é o valor da data introduzida, quando válida.

Já agora estas duas linhas:

Set W = Worksheets("Folha1")
N = W.Range("C1000").End(xlUp).Row

eu devia ter colocado fora do ciclo, ou seja antes do Do.

Não há necessidade de executar mais de uma vez.

[vostrikov]

Boas,

eu fiz o upload do ficheiro. aqui está o link http://www.sendspace.com/file/cexmdo

Se me poderes dar uma ajuda agradeço-te

Mais uma vez obrigado.

Cumprimentos,

[FreiNando]

Testei e o código funciona.

Mas deves alterar uns pormenores.

1- A lista final retem a formatação, pelo deves incluir a remoção da formatação.

    A seguir a : .Range("A2:K1000").ClearContents Inclui  .Range("A2:K1000").ClearFormats

2- O filtro deve ficar no cabeçalho, mas só vai funcionar se não houver linhas em branco.

    Retira a linha em branco e muda "C3" para "C1" como referência ao filtro.

[vostrikov]

Boas,

fiz o que tu me disseste.

e agora sempre que introduzo a data de entrega ele diz que não tem uma data valida e esta sempre a pedir nova data.

Alterei alguma de errado??

Ficheiro: http://www.sendspace.com/file/gyh1u2

Obrigado mais uma vez.

Cumprimentos

[FreiNando]

Isso tem a ver com a formatação da coluna C.

Escolhe o formato de Data que tem um (*) asterisco no inicio.

Realmente ainda não me tinha acontecido isto. Mas tem a ver com o facto do critério dos filtros ser do tipo texto e não de valor.

Para poderes ter qualquer formato de data nessa coluna, substitui a instrução de filtragem por esta:

        W.Range("C1").AutoFilter 3, ">=" & CLng(D), xlAnd, "<" & CLng(D) + 1

Aparentemente só o "=" não serve, tem de haver uma comparação com um intervalo.

É que o tipo DateTime usado no Excel tem a data(dias, meses e ano) na parte inteira e o tempo (horas,minuto e segundos) na parte decimal.

[vostrikov]

Boas,

Muito Obrigado, está a trabalhar muito bem, és o maior.

Obrigado mais uma vez. Vou continuar a programar coisas mais simples para depois ir as mais complexas. Obrigado pela Orientação.

Cumprimentos.