Notifications
Clear all

Corrigindo rotina e macro para comparação de intervalos

1 Posts
1 Usuários
0 Reactions
1,011 Visualizações
 toni
(@toni)
Posts: 2
New Member
Topic starter
 

Olá, como vão?

Preciso de um help e tenho 2 pedidos a vocês:
I) Consertar os macros de uma rotina;
II) Criar uma macro para comparar dois intervalos e copiar os valores repetidos para um outro lugar.

I) Rotina:
Parte 1) Ao clicar em D1, copia os valores de J2:K73 para A2:B73;

Parte 2) Ao clicar em E1, remove os valores repetidos na coluna A2:A73 e na coluna B2:A73;

Parte 3) Ao clicar em F1, remove os valores repetidos entre as colunas A2:A73 e B2:B73.

O que alterar?
Na macro da Parte 2:
Continuar removendo os repetidos, adicionar uma linha para remover os zeros, sem apagar a linha toda somente os zeros de A2:B73.
Gostaria que fosse feito no estilo da macro abaixo de maneira automática e sem AutoFilter.
Ela apaga as células vazias e move os valores para cima deixando um embaixo do outro.

<Sub apagaLinha()
Columns("A:A").Select 'Adapte para a coluna que quiser
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
End Sub>

Na macro da Parte 3:
Quando você finalizar a rotina clicando na célula F1, você vai olhar as células J29 e K29 e vai observar que a macro
puxou duas células do intervalo J2:K73 para esquerda e esse "puxão" sempre acontece e que também ficou uma célula vazia.
Gostaria que você consertasse esses dois erros (Puxão e Não deixar células vazias), fazendo com que o intervalo fique fixo e inalterado.

No momento os valores da coluna B estão fixos e os valores repetidos da coluna A são excluídos, gostaria que fosse
o contrário, coluna A fixa e os valores repetidos da coluna B excluídos.

II)
Gostaria de comparar dois intervalos quaisquer e copiar os valores repetidos em uma outra coluna apenas 1 vez, assim como
está na planilha, usando os valores do primeiro intervalo como referência.

Fiz uma pesquisa e encontrei uma macro parecida com o que preciso e ela faz o seguinte:
- Se em uma coluna o valor se repetir 3 vezes, então retorna o valor na coluna H 2 vezes;
- Se o valor se repetir 2 vezes, então retorna 1.

<Sub CopiarDuplicados()
Dim i As Long
Dim QtLinhas As Long

QtLinhas = [A1].CurrentRegion.Rows.Count

For i = 1 To QtLinhas
If WorksheetFunction.CountIf(Range(Cells(1, 1), Cells(i, 1)), Cells(i, 1).Value) > 1 Then
Cells(i, 1).Copy Cells(Cells.Rows.Count, "H").End(xlUp).Offset(1, 0)
End If
Next
End Sub>

Vou usar o exemplo da planilha pra ficar melhor a visualização:
- A macro iria começar a varrer as duas primeiras colunas começando pela célula W2 indo até W28, de X2 até X28, depois ia
comparar com as outras duas colunas em Z2 a Z33 e AA2 a AA32;
- Depois de comparar, o macro faria uma contagem dos valores repetidos;
- Se a contagem for par, exemplo (46), a macro copiaria uma metade na primeira coluna e outra na coluna ao lado
- Se for ímpar, exemplo (45), copiaria a metade (22) +1 na primeira coluna e outra metade (22) na coluna ao lado.

Resumindo:
1) Comparar W2:X28 com Z2:AA32;
2) Fazer a contagem dos repetidos;
3) Copiar os repetidos para um outro intervalo respeitando a contagem.

Sei que isso se resolveria com fórmulas, porém como a planilha se resume a valores, quero deixar ela assim.

Agradeço a atenção

 
Postado : 27/11/2020 10:56 pm