Home Excel - Downloads / Areas Restritas Excel VBA - Duplicados

Excel VBA - Duplicados

  • - Acesso Livre
  • Documentos

    Ordenar por : Nome | Data | Acessos [ Descendente ]

    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: 85.87 KB
    Downloads: 1200

    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.



     

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

    popular!
    Adicionado em: 19/11/2011
    Modificado em: 19/11/2011
    Tamanho: 88.61 KB
    Downloads: 1323

    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 vba planilha mescla celulas duplicados Excel vba planilha mescla celulas duplicados

    popular!
    Adicionado em: 06/04/2012
    Modificado em: 06/04/2012
    Tamanho: 86.19 KB
    Downloads: 1139

    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.

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

    popular!
    Adicionado em: 21/11/2010
    Modificado em: 21/11/2010
    Tamanho: 27.59 KB
    Downloads: 945

    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


    vba duplicados elimina ou insere cores numeros duplicados vba duplicados elimina ou insere cores numeros duplicados

    popular!
    Adicionado em: 21/11/2010
    Modificado em: 21/11/2010
    Tamanho: 20.68 KB
    Downloads: 907

    Saberexcel - o Site das Macros
    Essa macro do Aplicativo Microsoft Excel VBA, deleta dados duplicados em determinada região, voce poderá selecionar manualmente a região que deseja examinar e deletar todos os dados duplicados, da também para verificar os dados duplicados e não duplicados, só adptar código na macro, observe as cores do interior da célula, as que a condição if for Verdadeira e ou falsa.

    Sub Duplicados_ou_nao_Duplicados()
    Dim sbColecao As New Collection, Cell As Range, sbRegiao As Range
    If [M12].Value = "Dados duplicados deletados" Then
    MsgBox ("Dados duplicados já deletados, insira novamente novos dados"), vbCritical, "Saberexcel - site das Macros"
    Exit Sub
    End If

    On Error Resume Next
    Set sbRegiao = Application.InputBox("Selecione área [range a examinar]", "Saberexcel - site das macros", Type:=8)
    If IsEmpty(sbRegiao) Then Exit Sub

    For Each Cell In sbRegiao
    If Cell.Value <> "" Then
    sbColecao.Add Cell.Value, CStr(Cell.Value)
    If Err <> 0 Then
    Err.Clear
    Cell.ClearContents
    'Cell.Interior.ColorIndex = 43
    Else
    'Cell.ClearContents
    Cell.Interior.ColorIndex = 6
    End If
    End If
    Next Cell
    [M12].Value = "Dados duplicados deletados"
    End Sub

    Sub copiar_para_teste()
    Sheets("Plan2").Select
    Range("A1:J10").Select
    Selection.Copy
    Sheets("Plan1").Select
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select
    [M12].Value = "Novos dados inseridos para teste"
    End Sub

    Aprenda sobre Aplicativo Microsoft Excel VBA (SaberExcel)




    Página 1 de 2

    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