none
Extrair valores duplicados de colunas, mantendo as linhas originais. RRS feed

  • Pergunta

  • Boa noite<o:p></o:p>

    Pesquisando por tópicos semelhante o mais próximo que encontrei foi a solução proposta pelo Benzadeus em 12/08/2012, sob o titulo: "Extrair dados de um intervalo para uma unica coluna". Na planilha postada tem o referido código e o esboço do que preciso, se alguém puder ajudar fico-lhe grato. http://www.sendspace.com/file/vqm6sk<o:p></o:p>

    terça-feira, 8 de outubro de 2013 04:16

Respostas

  • Sub fnc()
      Dim lngRow As Long
      Dim col As Collection
      Dim wks As Worksheet
      Dim rng As Range
      
      Set wks = ActiveSheet
      Set col = New Collection
      
      With WorksheetFunction
        On Error Resume Next
        For lngRow = 3 To 14
          Set rng = wks.Cells(lngRow, "B").Resize(, 3)
            col.Add lngRow, CStr(.Small(rng, 1) & .Small(rng, 2) & .Small(rng, 3))
            If Err.Number = 457 Then
              wks.Rows(lngRow).ClearContents
              Err.Clear
            End If
        Next lngRow
        On Error GoTo 0
      End With
    End Sub

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br


    terça-feira, 8 de outubro de 2013 22:04
    Moderador

Todas as Respostas

  • Sub fnc()
      Dim lngRow As Long
      Dim col As Collection
      Dim wks As Worksheet
      Dim rng As Range
      
      Set wks = ActiveSheet
      Set col = New Collection
      
      With WorksheetFunction
        On Error Resume Next
        For lngRow = 3 To 14
          Set rng = wks.Cells(lngRow, "B").Resize(, 3)
            col.Add lngRow, CStr(.Small(rng, 1) & .Small(rng, 2) & .Small(rng, 3))
            If Err.Number = 457 Then
              wks.Rows(lngRow).ClearContents
              Err.Clear
            End If
        Next lngRow
        On Error GoTo 0
      End With
    End Sub

    Felipe Costa Gualberto - http://www.ambienteoffice.com.br


    terça-feira, 8 de outubro de 2013 22:04
    Moderador
  • Bom dia 

    Parece mágica, mas não é. Muito obrigado pela solução.

    quarta-feira, 9 de outubro de 2013 11:12