Você pode tentar este método. Ele faz uso de uma classe definida pelo usuário para ajudar na coleta de itens exclusivos na segunda coluna.
O código, nos Módulos Regular e de Classe, utiliza o fato de que, quando você tenta adicionar um membro à coleção que possui a mesma Chave que um membro existente, será gerado um erro 457 . / p>
Você pode ver no código onde fazer alterações para considerar as diferenças em sua planilha e intervalos para a Origem (Src) e Resultados (Res).
Você DEVE RENOMEAR o módulo da classe cConBy . Depois que você Insert Class Module , F4 abre a janela de propriedades. Altere o parâmetro Name lá.
Módulo de turma
Option Explicit
Private pConBy As String
Private pProd As String
Private pProds As Collection
Private Sub Class_Initialize()
Set pProds = New Collection
End Sub
Public Property Get ConBy() As String
ConBy = pConBy
End Property
Public Property Let ConBy(Value As String)
pConBy = Value
End Property
Public Property Get Prod() As String
Prod = pProd
End Property
Public Property Let Prod(Value As String)
pProd = Value
End Property
Public Function AddProd(Value As String)
On Error Resume Next
pProds.Add Value, CStr(Value)
On Error GoTo 0
End Function
Public Property Get Prods() As Collection
Set Prods = pProds
End Property
Módulo regular
Option Explicit
Sub UniqueConBy()
Dim cCB As cConBy, colCB As Collection
Dim wsSrc As Worksheet, wsRes As Worksheet, rRes As Range
Dim vSrc As Variant, vRes() As Variant
Dim I As Long, J As Long, K As Long
Dim lRowCount As Long
'Source and results location
Set wsSrc = Worksheets("Sheet1")
Set wsRes = Worksheets("Sheet1")
Set rRes = wsRes.Cells(1, 5)
With wsSrc
vSrc = .Range(.Cells(1, 1), .Cells(.Rows.Count, 1).End(xlUp)).Resize(columnsize:=2)
End With
'Collect and consolidate the data
Set colCB = New Collection
On Error Resume Next
For I = 2 To UBound(vSrc, 1)
Set cCB = New cConBy
With cCB
.ConBy = vSrc(I, 1)
.Prod = vSrc(I, 2)
.AddProd .Prod
lRowCount = lRowCount + 1
colCB.Add cCB, CStr(.ConBy)
Select Case Err.Number
Case 457
With colCB(CStr(.ConBy))
lRowCount = lRowCount - .Prods.Count - 1
.AddProd cCB.Prod
lRowCount = lRowCount + .Prods.Count
End With
Err.Clear
Case Is <> 0
MsgBox "Error: " & Err.Number & vbTab & Err.Description
Stop
End Select
End With
Next I
On Error GoTo 0
'Create results array
ReDim vRes(0 To lRowCount, 1 To 2)
'column labels
For I = 1 To UBound(vRes, 2)
vRes(0, I) = vSrc(1, I)
Next I
'populate the array
For I = 1 To colCB.Count
With colCB(I)
K = K + 1
vRes(K, 1) = .ConBy
vRes(K, 2) = .Prods(1)
For J = 2 To .Prods.Count
K = K + 1
vRes(K, 2) = .Prods(J)
Next J
End With
Next I
Set rRes = rRes.Resize(UBound(vRes, 1) + 1, UBound(vRes, 2))
With rRes
.EntireColumn.Clear
.Value = vRes
With .Rows(1)
.Font.Bold = True
.HorizontalAlignment = xlCenter
End With
.EntireColumn.AutoFit
End With
End Sub
EDITAR:
Um método alternativo, que se aproxima do que você quer, mas que oferece uma saída ligeiramente diferente, seria simplesmente usar a opção Remover Duplicatas na guia Data Ribbon / Data Tools. Você selecionaria as colunas A e B.
Garanta que seus dados sejam classificados antes de aplicar esse método (a classificação não seria necessária usando o método VBA).
Com seus dados postados, os resultados seriam semelhantes:
VocêpoderiausaraformataçãocondicionalparaeliminarasentradasduplicadasnaColunaA.porexemplo:useumafórmulade=$A2=$A1eformateacordotextoparateramesmacordoplanodefundo.OvalorCon.Byaindaestarialá,masnãoseriavisível.
