Home Excel - Downloads / Areas Restritas Excel VBA - Duplicados

Excel VBA - Duplicados

  • - Acesso Livre
  • Documentos

    Ordenar por : Nome | Data | Acessos [ Ascendente ]

    vba duplicados copiando valores nao duplicados vba duplicados copiando valores nao duplicados

    popular!
    Adicionado em: 21/11/2010
    Modificado em: 21/11/2010
    Tamanho: Vazio
    Downloads: 1199

    Essa macro do Aplicativo Microsoft Excel VBA, juntamente com uma função retornam valores únicos em determinada coluna coluna,
    observe que a macro copia para coluna(B) valores únicos existentes na coluna(A), valores não duplicados.


    Sub Copiar_valores_unicos()
    Dim coll As Collection, i As Long
    Set coll = RetornaValorUnico(Range("A1:A100"))
    If coll Is Nothing Then Exit Sub

    Range("C1:C100").Clear
    For i = 1 To coll.Count
    Range("C1").Offset(i - 1, 0).Formula = coll(i)
    Next i
    End Sub



    Function RetornaValorUnico
    (KeyRange As Range, Optional ItemRange As Range) As Collection
    Dim r As Long, c As Long, varItem As Variant, strKey As String
    If Not KeyRange Is Nothing Then
    Set RetornaValorUnico = New Collection
    With KeyRange
    For c = 1 To .Columns.Count
    For r = 1 To .Rows.Count
    strKey = vbNullString
    varItem = vbNullString

    On Error Resume Next
    strKey = Trim(CStr(.Cells(r, c).Value))

    If Not ItemRange Is Nothing Then
    varItem = ItemRange.Cells(r, c).Value
    Else
    varItem = .Cells(r, c).Value
    End If

    If Len(strKey) > 0 Then
    RetornaValorUnico.Add varItem, strKey
    End If
    On Error GoTo 0
    Next r
    DoEvents
    Next c
    End With
    If RetornaValorUnico.Count = 0 Then
    Set RetornaValorUnico = Nothing
    End If
    End If
    End Function

     

    Sub limpar_teste()
    [C:C].ClearContents
    End Sub


    Aprenda Aplicativo Microsoft Excel VBA com SaberExcel - o site das macros


    Excel vba planilha mescla celulas duplicados Excel vba planilha mescla celulas duplicados

    popular!
    Adicionado em: 06/04/2012
    Modificado em: 06/04/2012
    Tamanho: Vazio
    Downloads: 1470

    Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções

    E
    sse macro do aplicativo Microsoft Excel VBA(Visual Basic Application), mescla células duplicadas, deletando em parte as células duplicadas
    baixe o exemplo de planiha no final da página, há uma macro para copiar os dados para facilitar o teste.
    Fique com Deus, Expedito Marcondes
    'veja nosso curso completo microsoft com vídeo aulas (Aprenda programar, brincando com Excel é bem divertido)
    ' - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Sub sbx_fusao_duplicados_vertical()
    Dim L As Long ' linha
    Dim d As Long ' duplicados
    Dim c As Integer ' coluna

    Const minL = 1 ' linha inicial
    Const maxL = 15 ' linha final
    Const minC = 1 ' inicio coluna
    Const maxC = 3 ' fim coluna

    Application.ScreenUpdating = False
    Application.DisplayAlerts = False

    For c = minC To maxC 'colunas
    For L = minL To maxL 'linhas

    For d = L + 1 To maxL
    If (Cells(L, c) <> Cells(d, c)) Then Exit For
    Next d

    If d > L + 1 Then
    With Cells(L, c).Resize(d - L, 1)
    .HorizontalAlignment = xlCenter
    .VerticalAlignment = xlCenter
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .IndentLevel = 0
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = True
    End With
    End If
    Next L
    Next
    c

    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Saber1.[f9].Value = "Area com Duplicados foram Mescladas!"
    End Sub
    ' - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Sub copiar_teste()
    Saber1.Cells.Clear
    [a].Copy [b] 'renomeei intervalo de células(a) Saber2[a1:c22] e b(a1)Plan1
    Saber1.[f9].Value = "Execute o macro para mesclar areas com duplicados!"
    End Sub



    Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.



    Baixe o exemplo de planilha contendo os macros acima:
    Registre-se em nosso site, há muitos donwloads na áre livre para Registrados,
    Fiquem com Deus.  Expedito Marcondes.

    Excel vba deletar linhas duplicados criterio Excel vba deletar linhas duplicados criterio

    popular!
    Adicionado em: 19/11/2011
    Modificado em: 19/11/2011
    Tamanho: Vazio
    Downloads: 1601

    Saberexcel - o site de quem precisa aprender macros microsoft excel vba

    Esse macro do Aplicativo Microsoftexcel Excel VBA, com auxilio de uma inputbox para o critério de deleção de linhas preserva a linha com ítem escolhido ou seja preserva valores únicos ou ao contrário deleta os únicos e preserva os duplicados, pois a deleção de dá pelo critério do nome contido na fórmula na coluna (C) - 'Único" ou "Duplicado". no final da página há um link para baixar o exemplo de planilha contendo o macro abaixo.
    Espero que o exemplo possa ajudá-los.
    '- - - - - - - - - - -- - - - - - - - - - - - - - - - - - - - -
    A Fórmula usada para retornar o critério dos duplicados é:
    '=SE(CONT.SE($A$2:B2;B2)>1;"Duplicado";"Único")
    '- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    Sub Loop_for_next_preservar_palavra_exluir_linha()
    vCriterio = InputBox("Digite a palavra que desejar preservar:", "Escola Saberexcel VBA Estudos®", "Único")
    If vCriterio = Cancel Then 'caso o usuário resolva cancelar a operação para nao ocorrer erro.
    Exit Sub
    End If

    If CStr(vCriterio) <> "Único" And CStr(vCriterio) <> "Duplicado" Then
    MsgBox ("valores não existente, digite novamente")
    vCriterio = InputBox("Digite a palavra que deseja preservar:", "Escola Saberexcel VBA Estudos®", "Único")
    If vCriterio = Cancel Then'caso o usuário resolva cancelar a operação para nao ocorrer erro.
    Exit Sub
    End If
    End If

    For i = ActiveSheet.Cells(65536, 1).End(xlUp).Row To 2 Step -1
    If Cells(i, 3).Value <> vCriterio Then
    Cells(i, 3).EntireRow.Delete Shift:=xlUp
    End If
    Next i

    MsgBox ("Linhas contendo dados [ ") & vCriterio & " ] foram PRESERVADAS!!!", _
    vbInformation, "Saberexcel - o site das macros"
    End Sub

    Sub copiar_teste()
    [a].Copy [b] 'aqui renomeiei a área 'a' (Plan(Auxiliar)(A1:D21)) a ser copiada e célula(A1) como [b] para receber os dados 'a'
    End Sub
    ' - - - - - - - - - - - - - - - - - - - - - - -
    Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.




    Excel planilha vba funcao retorna valores unicos Excel planilha vba funcao retorna valores unicos

    popular!
    Adicionado em: 27/12/2011
    Modificado em: 27/12/2011
    Tamanho: Vazio
    Downloads: 1548

    Escola Saberexcel VBA Estudos - o site de quem precisa aprender Macros ms Excel VBA

    Esses macro e Função do aplicativo Microsoft Excel VBA(Visual Basic Application), retorna os o total de ítens ou nomes não duplicados, em determinada coluna. Observe que a título didático usei também o VBA(Visual Basic Application) para chamar a função e retornar o valor (totalizando os nomes não duplicados) em mensagem e também direcionado para célula B1 na folha de planilha principal.
    Espero que o exemplo possa lhe ser útil. também inserí umas variáveis Constante com finalidade didática.
    Fique com Deus, Expedito Marcondes.


    Const a = "Escola Saberexcel VBA Estudos®"
    Const s = vbInformation

    Function ContarValorUnico(Intervalo As Range)
    Dim iValoresUnicos As New Collection
    On Error Resume Next

    For Each vCelulas In Intervalo
    iValoresUnicos.Add vCelulas.Value, CStr(vCelulas.Value)
    Next vCelulas


    On Error GoTo 0
    ContarValorUnico = iValoresUnicos.Count
    End Function

    'observem que o endereço do intervalo (Range()) área é expandido pela variável (x)
    '------
    Sub md_chamar_funcao()
    Dim X As Integer
    X = Saber1.Range("A" & Application.Rows.Count).End(xlUp).Row

    [b1] = ContarValorUnico(Range("a1" & ":A" & CStr(X)))
    MsgBox "Existem [ " & ContarValorUnico(Range("a1" & ":A" & CStr(X))) & " ] Valores não duplicados ", s, a
    End Sub


    Aprenda tudo sobre planilhas do Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Escola Saberexcel VBA Estudos® - Treinamentos com Macros, Fórmulas e Funções.



     

    Página 2 de 2

    PROMOÇÃO DIDÁTICOS SABEREXCEL



    Adquira já o Acesso Imediato
    à Area de Membros

    Compra Grantida --- Entrega Imediata

    Aprenda Excel VBA com Simplicidade de 
    códigos e Eficácia, Escrevendo Menos e
    Fazendo Mais.

    '-------------------------------------'
    Entrega Imediata:
    +  500 Video Aulas MS Excel VBA
    +  35.000 Planilhas Excel e VBA
    +  Coleção 25.000 Macros MS Excel VBA
    +  141 Planilhas Instruções Loops
    +  341 Planilhas WorksheetFunctions(VBA)
    +    04 Módulos Como Fazer Excel VBA
    +  Curso Completo MS Excel VBA
    +  Planilhas Inteligentes


    Pesquisa Google SaberExcel

    Publicidade Google

    <script type="text/javascript"><!--

    google_ad_client = "ca-pub-2317234650173689";

    /* retangulo 336 x 280 */

    google_ad_slot = "0315083363";

    google_ad_width = 336;

    google_ad_height = 280;

    //-->

    </script>

    <script type="text/javascript"

    src="http://pagead2.googlesyndication.com/pagead/show_ads.js">

    </script>

    Publicidade

    RSFirewallProtected


    Google Associados

    Depoimentos

    Adicione Saberexcel Favoritos

     
     

    Aprenda tudo sobre o Aplicativo Microsoft Excel VBA

    Aprenda tudo sobre o Aplicativo Microsoft Excel VBA(Visual Basic Application), sozinho, com baixo custo, praticando com os produtos didáticos Saberexcel,


       Sobre as WorksheetFunctions Funções de Planilhas que retornam valores do VBA