none
CONTAR LINHAS SELECIONADAS + MsgBox RRS feed

  • Pergunta

  • Bom tarde!!!

    Caros, estou com a seguinte situação.

    'Usando a seguinte estrutura: 
    Range("D" & Rows.Count).End(xlUp).Select
    Range(Selection, Selection.End(xlUp)).Offset(1, 0).Select
    'Até consigo deslocar uma linha o "cabeçalho" mas a seleção da ultima linha da planilha também deslocada para baixo.

    Neste caso o que devo fazer para deslocar a apenas a primeira linha para baixo?
    ______________________________________________________________________________________________________
    'Apos a seleção de forma correta desejo contar quantas linhas foram selecionadas EXCETO O CABEÇALHO.
    e mostrar um MsgBox com a quantidade de linhas contadas. ex: "3 linhas não encontradas"

    Neste caso o que devo fazer para deslocar a apenas a primeira linha para baixo?
    _______________________________________________________________________________________



    • Editado CS_RODRIGO quarta-feira, 20 de setembro de 2017 15:08
    quarta-feira, 20 de setembro de 2017 15:07

Respostas

Todas as Respostas

  • Anderson, obrigado por se dispor.

    conforme imagem ,  quero selecionar os códigos na coluna "D" 

    Range("D" & Rows.Count).End(xlUp).Select
    Range(Selection, Selection.End(xlUp)).Offset(1, 0).Select

    Com a estrutura acima percebe que  a seleção deslocou uma para linha de baixo  no geral, eu quero que desloque uma linha para baixo sim, mas a partir do cabeçalho . Ex: selecionando só os cód e ão o titilo da coluna

    A partir  da seleção correta , quero q mostre uma MsgBox  indicando quantos cod foram selecionados .

    Desde já muito obrigado!

    quarta-feira, 20 de setembro de 2017 17:31
  • Anderson, é exatamente isso que preciso. 

    selecionar os códigos dessa forma porém nem sempre serão toda a coluna porque antes de executar o programa faço um filtro por erro #N/D na coluna J ou K

    É possível programar  isso dentro de uma condição logica que seria 

    selecionar as células na coluna "D"  que sejam diferente de vazia e que  na coluna J:K seja igual a #N/D
    e aparecer o mesmo MsgBox foram selecionados x cód.  , quando eu clicar em ok ele copiar os cód que foram selecionados e se não tiver nenhum cód nessa condição aparecer nenhum cód selecionado e segue executando o resto do programa.

    quarta-feira, 20 de setembro de 2017 21:34
  • 
    quarta-feira, 20 de setembro de 2017 23:27
  • Conforme imagem eu preciso que o programa  procure  NA PLAN1 coluna "D" MATERIAL  células que sejam <> " " e na mesma linha as colunas "J" VALOR e "K"  AGREGADO sejam = #N/D .

    SESIM SELECIONAR AS CELULAS ENCONTRADAS NA COLUNA "D"

    MsgBox "foram encontrados x códigos"

    COPIAR CELULAS SELECIONADAS 

    Ativar PLAN2 

    NA COLUNA A LOCALIZAR A PRIMEIRA CELULA VAZIA  E COLAR OS CODIGOS.

    _________________________________________-

    SENÃO 

    MsgBox " TODOS OS CÓDIGOS ENCONTRADOS"


    quinta-feira, 21 de setembro de 2017 00:36
  • Ola Roodrigoo, se voce ainda nao resolveu a questao teste esse daqui.

    Option Explicit
    Sub VeriCodigo()
    Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim myRange As Range
    Dim cnt As Integer
    Application.ScreenUpdating = False
    
    Set wb = ThisWorkbook
    Set ws1 = wb.Worksheets("Planilha1")
    Set ws2 = wb.Worksheets("Planilha2")
    For Each myRange In ws1.Range("D2:D" & ws1.Range("D" & Rows.Count). _
        End(xlUp).Row).SpecialCells(xlCellTypeVisible)
        If myRange <> "" And IsError(myRange.Offset(0, 6)) _
            And IsError(myRange.Offset(0, 7)) Then
                cnt = cnt + 1
                myRange.Copy
                ws2.Range("A" & ws2.Range("A" & Rows.Count). _
                    End(xlUp).Row + 1).PasteSpecial xlPasteValues
        End If
    Next myRange
    If cnt = 0 Then
        MsgBox "Foram Encontrados Todos os Codigos"
    Else
        MsgBox "Nao Encontrado/s " & cnt & " Codigo/s"
    End If
    ws1.Select
    Range("A2").Select
    
    Set wb = Nothing
    Set ws1 = Nothing
    Set ws2 = Nothing
    Set myRange = Nothing
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    End Sub

    .....desculpe foi corrigido o erro na linha

    Dim wb As Workbook

    Set wb = Nothing



    quinta-feira, 21 de setembro de 2017 11:47
  • Boa tarde!

    testei as duas opções e não deu certo.

    Sub vericodigo()

    Sub contarcodigos()

    Executa , localiza os códigos que deu erro.

    O problema é que está copiando toda a linha , e na verdade precisa copiar só a célula da coluna D que é código. 

    e na hora de copiar colar na plan2  ta aparecendo um MsgBox para cada linha  "foram encontrados 1 código" depois "dois códigos" 

    e está colando na coluna  A na linha 6 e na verdade ele precisa procurar a linha vazia.

    • Editado CS_RODRIGO quinta-feira, 21 de setembro de 2017 18:06
    quinta-feira, 21 de setembro de 2017 17:26
  • Já testei e deu certo.

    Como pode ver na planilha abaixo:

    https://drive.google.com/file/d/0B5y9tcyfn9D3cFVFNnNuV1h2Tlk/view?usp=sharing


    Anderson Diniz

    • Sugerido como Resposta AndersonFDiniz2 quinta-feira, 21 de setembro de 2017 18:20
    • Marcado como Resposta CS_RODRIGO sexta-feira, 10 de novembro de 2017 12:53
    quinta-feira, 21 de setembro de 2017 18:20
  • Sub ContarCodigos()
        
                            Dim linha2 As Long
                        linha2 = 1
        Dim linha As Long
        Dim cont As Long
        Dim achou As Boolean
        cont = 0
        For linha = 2 To ThisWorkbook.Sheets("Planilha1").UsedRange.Rows.Count
            
            If ThisWorkbook.Sheets("Planilha1").Range("D" & linha) <> "" Then
                
                If IsError(ThisWorkbook.Sheets("Planilha1").Range("J" & linha)) Then
                    
                    If IsError(ThisWorkbook.Sheets("Planilha1").Range("K" & linha)) Then
                        ThisWorkbook.Sheets("Planilha1").Select
                        ThisWorkbook.Sheets("Planilha1").Range("D" & linha).Select
                        Selection.Copy
                        cont = cont + 1
                        achou = True
                        
    
                        
                        While ThisWorkbook.Sheets("Planilha2").Range("A" & linha2) <> ""
                            
                            linha2 = linha2 + 1
                            
                        Wend
                        ThisWorkbook.Sheets("Planilha2").Select
                        ThisWorkbook.Sheets("Planilha2").Range("A" & linha - 1).Select
                        ActiveSheet.Paste
                    Else
                        
                        
                        
                    End If
                    
                End If
                
            End If
            
    
            
        Next linha
                If achou = True Then
                
                MsgBox "Foram encontrados " & cont & " códigos."
                
            Else
                
                MsgBox "Todos os códigos foram encontrados."
            End If
    End Sub
    


    Anderson Diniz

    • Sugerido como Resposta AndersonFDiniz2 quinta-feira, 21 de setembro de 2017 18:33
    quinta-feira, 21 de setembro de 2017 18:32
  • segue evidência.
     do problema citado a cima. na sub contarcodigo()

    quinta-feira, 21 de setembro de 2017 19:31
  • Sub ContarCodigos()
        
                            Dim linha2 As Long
                        linha2 = 1
        Dim linha As Long
        Dim cont As Long
        Dim achou As Boolean
        cont = 0
        For linha = 2 To ThisWorkbook.Sheets("Planilha1").UsedRange.Rows.Count
            
            If ThisWorkbook.Sheets("Planilha1").Range("D" & linha) <> "" Then
                
                If IsError(ThisWorkbook.Sheets("Planilha1").Range("J" & linha)) Then
                    
                    If IsError(ThisWorkbook.Sheets("Planilha1").Range("K" & linha)) Then
                        ThisWorkbook.Sheets("Planilha1").Select
                        ThisWorkbook.Sheets("Planilha1").Range("D" & linha).Select
                        Selection.Copy
                        
                        achou = True
                        
    
                        
                        While ThisWorkbook.Sheets("Planilha2").Range("A" & linha2) <> ""
                            
                            linha2 = linha2 + 1
                            
                        Wend
                        ThisWorkbook.Sheets("Planilha2").Select
                        ThisWorkbook.Sheets("Planilha2").Range("A" & linha - 1).Select
                        ActiveSheet.Paste
                    Else
                        
                        
                        
                    End If
                    
                End If
                
            End If
            
    
            
        Next linha
                If achou = True Then
                Dim I As Long
                For I = ThisWorkbook.Sheets("Planilha2").UsedRange.Rows.Count To 1 Step -1
                
                If ThisWorkbook.Sheets("Planilha2").Cells(I, 1) <> "" Then
                
                cont = cont + 1
                
                End If
                
                
                
                
                Next I
                
                MsgBox "Foram encontrados " & cont & " códigos."
                
            Else
                
                MsgBox "Todos os códigos foram encontrados."
            End If
    End Sub
    


    Anderson Diniz

    quinta-feira, 21 de setembro de 2017 20:04
  • favor enviar a planilha para diniabr2011@gmail.com para que eu possa corrigir

    Anderson Diniz

    quinta-feira, 21 de setembro de 2017 20:06
  • Anderson, segue a resolução do problema.

    Se possível teste.

    Sub ContarCodigos()
        
        Dim linha2 As Long
        linha2 = 1
        Dim linha As Long
        Dim cont As Long
        Dim achou As Boolean
        cont = 0
        For linha = 2 To ThisWorkbook.Sheets("Planilha1").UsedRange.Rows.Count
            If ThisWorkbook.Sheets("Planilha1").Range("D" & linha) <> "" Then
                If IsError(ThisWorkbook.Sheets("Planilha1").Range("J" & linha)) Then
                    If IsError(ThisWorkbook.Sheets("Planilha1").Range("K" & linha)) Then
                        ThisWorkbook.Sheets("Planilha1").Select
                        ThisWorkbook.Sheets("Planilha1").Range("D" & linha).Select
                        Selection.Copy
                        achou = True
                        ThisWorkbook.Sheets("Planilha2").Select
                        Range("A" & Rows.Count).End(xlUp).Offset(1, 0).Select
                        ActiveSheet.Paste
                        cont = cont + 1
                     Else
                    End If
                End If
            End If
        Next linha
            If achou = True Then
                Dim I As Long
                For I = ThisWorkbook.Sheets("Planilha2").UsedRange.Rows.Count To 1 Step -1
                
                If ThisWorkbook.Sheets("Planilha2").Cells(I, 1) <> "" Then
                End If
                Next I
                MsgBox "Foram encontrados " & cont & " códigos."
            Else
                MsgBox "Todos os códigos foram encontrados."
            End If
    End Sub

    quinta-feira, 21 de setembro de 2017 23:32
  • Segue o link com a planilha.

    https://we.tl/QE5m4sWTCk

    quinta-feira, 21 de setembro de 2017 23:39
  • Ola Roodrigoo.

    Abaixei a sua planilha e achei muito bom.

    So uma observacao, quando vi a sua primeira exposicao da planilha, notei que tem aplicado um filtro, entao pensei que voce queria rodar a rotina encima de dados visiveis apos o filtro.A rotina que voce expos acima, acho que apesar de aplicar o filtro o codigo For varre todas linhas visiveis e ocultas pelo filtro.

    Caso voce use sem o filtro, o que voce expos ta beleza, caso contrario teste novamente o VeriCodigo que tinha um pequeno erro que foi corrigido.

    Tadao

    sexta-feira, 22 de setembro de 2017 01:38
  • Entendi, realmente tinha o filtro na primeira exposição  Antonio.
    Então foi por isso que não rodou, não utilizei o filtro quando fiz o teste.

    De qualquer forma me foi de muita importância ajuda de vocês.

    Obrigado!!!

    Vamos para o próximo desafio .

    sexta-feira, 22 de setembro de 2017 02:03