excel - una - Combina Filas con valores duplicados, combina celdas si son diferentes

formula para buscar datos repetidos en excel

Question

Tengo una pregunta similar para [combinar Filas con valores duplicados] [1] Excel VBA - Combina filas con valores duplicados en una celda y fusiona valores en otra celda

Tengo datos en este formato (las filas están ordenadas)

Pub ID CH Ref
no 15 1 t2
no 15 1 t88
yes 15 2 t3
yes 15 2 t3
yes 15 2 t6

compare las filas adyacentes (por ejemplo, fila 4 y 5), si col 2 y 3 coinciden, si col col 4 merge col4 diferente, elimine la fila. si col 2,3,4 coincide y luego borra la fila, no combine col 4

Salida deseada

key ID CH Text
no 15 1 t2 t88
yes 15 2 t3 t6

Esta primera sección de código no funciona bien

Sub mergeCategoryValues()
Dim lngRow As Long
With ActiveSheet
Dim columnToMatch1 As Integer: columnToMatch1 = 2
Dim columnToMatch2 As Integer: columnToMatch2 = 3
Dim columnToConcatenate As Integer: columnToConcatenate = 4
lngRow = .Cells(65536, columnToMatch1).End(xlUp).row
.Cells(columnToMatch1).CurrentRegion.Sort key1:=.Cells(columnToMatch1), Header:=xlYes
.Cells(columnToMatch2).CurrentRegion.Sort key1:=.Cells(columnToMatch2), Header:=xlYes
Do
If .Cells(lngRow, columnToMatch1) = .Cells(lngRow - 1, columnToMatch1) Then ''check col 2 row lngRow, lngRow-1
If .Cells(lngRow, columnToMatch2) = .Cells(lngRow - 1, columnToMatch2) Then ''check col 3 row lngRow, lngRow-1
If .Cells(lngRow - 1, columnToConcatenate) = .Cells(lngRow, columnToConcatenate) Then
Else
.Cells(lngRow - 1, columnToConcatenate) = .Cells(lngRow - 1, columnToConcatenate) & "; " & .Cells(lngRow, columnToConcatenate)
End If
.Rows(lngRow).Delete
End If
End If
lngRow = lngRow - 1
Loop Until lngRow = 1
End With

Salida real incorrecta porque cuando las celdas se combinan t3 no coincidirá con t3; t6, mi comparación en col 4 solo funcionará en casos muy simples solamente.

Salida real

key ID CH Text
no 15 1 t2; t88
yes 15 2 t3; t3; t6

Por lo tanto, tuve que agregar estas dos secciones para dividir las celdas Concatenar y luego eliminar duplicados

''split cell in Col d to col e+ delimited by ;
With Range("D2:D6", Range("D" & Rows.Count).End(xlUp))
.Replace ";", " ", xlPart
.TextToColumns other:=True
End With
''remove duplicates in each row
Dim x, y(), i&, j&, k&, s$
With ActiveSheet.UsedRange
x = .Value: ReDim y(1 To UBound(x, 1), 1 To UBound(x, 2))
For i = 1 To UBound(x)
For j = 1 To UBound(x, 2)
If Len(x(i, j)) Then
If InStr(s & "|", "|" & x(i, j) & "|") = 0 Then _
s = s & "|" & x(i, j): k = k + 1: y(i, k) = x(i, j)
End If
Next j: s = vbNullString: k = 0
Next i
.Value = y()
End With
End Sub

Con salida de código adicional es

Pub ID CH Ref
no 15 1 t2 t88
yes 15 2 t3 t6

Pregunta: ¿Debe haber una manera mucho más fácil de hacer esto bien que usar tres métodos diferentes? ¿Qué hay de insertar nuevas columnas 5+ si los artículos col 4 no coinciden?

Nota: Eliminar el código duplicado se encontró desde user nilem en excelforum.

Editar: Col 1 siempre será igual si Col 2 y 3 coinciden. Si la solución es mucho más fácil, podemos suponer que Col 1 está en blanco e ignorar los datos.

He imprimido una tabla de búsqueda de libros y necesito convertirla a un formato simple que se usará en equipos que usan un lenguaje de 1960 que tiene comandos muy limitados. Intento preformatear estos datos, así que solo necesito buscar una fila que tenga toda la información.

La salida final de Col D puede estar en col D con delimitador o en col DK (solo 8 max Ref) porque voy a analizar para usar en otra máquina. Cualquier método es más fácil.

Answer 1

Como escribí anteriormente, iteraría a través de los datos y recogería cosas en el Objeto definido por el usuario. No es necesario que los datos se clasifiquen en este método; y los REF duplicados se omitirán.

Una ventaja de un objeto definido por el usuario es que facilita la depuración ya que puede ver más claramente lo que ha hecho.

Combinamos todas las líneas donde ID y CH son iguales, utilizando la propiedad del objeto Collection para generar un error si se utilizan claves idénticas.

En la medida en que se combinen las Refs en una sola celda con un delimitador, frente a las celdas individuales en las columnas D: K, cualquiera puede hacerse simplemente. Elegí separar en columnas, pero cambiarlo para combinarlo en una sola columna sería trivial.

Después de insertar el módulo de clase, debe cambiarle el nombre: cID_CH

Notará que coloqué los resultados en hojas de trabajo separadas. Podría sobrescribir los datos originales, pero desaconsejaría eso.

Módulo de clase

Option Explicit
Private pID As Long
Private pCH As Long
Private pPUB As String
Private pREF As String
Private pcolREF As Collection
Public Property Get ID() As Long
ID = pID
End Property
Public Property Let ID(Value As Long)
pID = Value
End Property
Public Property Get CH() As Long
CH = pCH
End Property
Public Property Let CH(Value As Long)
pCH = Value
End Property
Public Property Get PUB() As String
PUB = pPUB
End Property
Public Property Let PUB(Value As String)
pPUB = Value
End Property
Public Property Get REF() As String
REF = pREF
End Property
Public Property Let REF(Value As String)
pREF = Value
End Property
Public Property Get colREF() As Collection
Set colREF = pcolREF
End Property
Public Sub ADD(refVAL As String)
On Error Resume Next
pcolREF.ADD refVAL, refVAL
On Error GoTo 0
End Sub
Private Sub Class_Initialize()
Set pcolREF = New Collection
End Sub

Módulo regular

Option Explicit
Sub CombineDUPS()
Dim wsSRC As Worksheet, wsRES As Worksheet
Dim vSRC As Variant, vRES() As Variant, rRES As Range
Dim cI As cID_CH, colI As Collection
Dim I As Long, J As Long
Dim S As String
''Set source and results worksheets and results range
Set wsSRC = Worksheets("sheet1")
Set wsRES = Worksheets("sheet2")
Set rRES = wsRES.Cells(1, 1)
''Get Source data
With wsSRC
vSRC = .Range("A2", .Cells(.Rows.Count, "D").End(xlUp))
End With
''Collect and combine data
Set colI = New Collection
On Error Resume Next
For I = 1 To UBound(vSRC, 1)
Set cI = New cID_CH
With cI
.PUB = vSRC(I, 1)
.ID = vSRC(I, 2)
.CH = vSRC(I, 3)
.REF = vSRC(I, 4)
.ADD .REF
S = CStr(.ID & "|" & .CH)
colI.ADD cI, S
If Err.Number = 457 Then
Err.Clear
colI(S).ADD .REF
ElseIf Err.Number <> 0 Then
Debug.Print Err.Number, Err.Description
Stop
End If
End With
Next I
On Error GoTo 0
''Create and populate Results Array
ReDim vRES(0 To colI.Count, 1 To 11)
''Header row
vRES(0, 1) = "Pub"
vRES(0, 2) = "ID"
vRES(0, 3) = "CH"
vRES(0, 4) = "Ref"
''populate array
For I = 1 To colI.Count
With colI(I)
vRES(I, 1) = .PUB
vRES(I, 2) = .ID
vRES(I, 3) = .CH
For J = 1 To .colREF.Count
vRES(I, J + 3) = .colREF(J)
Next J
End With
Next I
''Write the results to the worksheet
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
Range(.Cells(4), .Cells(11)).HorizontalAlignment = xlCenterAcrossSelection
End With
.EntireColumn.AutoFit
End With
End Sub

Original

Resultados procesados

Answer 2

La práctica canónica para eliminar filas es comenzar en la parte inferior y avanzar hacia la parte superior. De esta manera, las filas no se saltan. El truco aquí es encontrar filas por encima de la posición actual que coincidan con las columnas B y C y concatenar las cadenas de la columna D antes de eliminar la fila. Hay varias buenas fórmulas de hoja de cálculo que pueden adquirir el número de fila de una coincidencia de dos columnas. Poniendo en práctica uno de ellos con la application.Evaluate Evaluar sería el método más conveniente para recopilar los valores de la columna D.

Sub dedupe_and_collect()
Dim rw As Long, mr As Long, wsn As String
With ActiveSheet ''<- set this worksheet reference properly!
wsn = .Name
With .Cells(1, 1).CurrentRegion
.RemoveDuplicates Columns:=Array(2, 3, 4), Header:=xlYes
End With
With .Cells(1, 1).CurrentRegion ''redefinition after duplicate removal
For rw = .Rows.Count To 2 Step -1 ''walk backwards when deleting rows
If Application.CountIfs(.Columns(2), .Cells(rw, 2).Value, .Columns(3), .Cells(rw, 3).Value) > 1 Then
mr = Application.Evaluate("MIN(INDEX(ROW(1:" & rw & ")+((''" & wsn & "''!B1:B" & rw & "<>''" & wsn & "''!B" & rw & ")+(''" & wsn & "''!C1:C" & rw & "<>''" & wsn & "''!C" & rw & "))*1E+99, , ))")
''concatenate column D
''.Cells(mr, 4) = .Cells(mr, 4).Value & "; " & .Cells(rw, 4).Value
''next free column from column D
.Cells(mr, Columns.Count).End(xlToLeft).Offset(0, 1) = .Cells(rw, 4).Value
.Rows(rw).EntireRow.Delete
End If
Next rw
End With
End With
End Sub

La eliminación de registros en una coincidencia de tres columnas se realiza con el equivalente VBA del comando Fecha ► Herramientas de datos ► Eliminar duplicados. Esto solo considera las columnas B, C y D y elimina los duplicados inferiores (manteniendo los más cercanos a la fila 1). Si la Columna A es importante a este respecto, se debería agregar codificación adicional.

No estoy seguro de si quería la columna D como cadena delimitada o celdas separadas como resultado final. ¿Podrías aclarar?

Answer 3

variante usando el diccionario a continuación

Sub test()
Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
Dic.Comparemode = vbTextCompare
Dim Cl As Range, x$, y$, i&, Key As Variant
For Each Cl In Range("B2:B" & Cells(Rows.Count, "B").End(xlUp).Row)
x = Cl.Value & "|" & Cl.Offset(, 1).Value
y = Cl.Offset(, 2).Value
If Not Dic.exists(x) Then
Dic.Add x, Cl.Offset(, -1).Value & "|" & y & "|"
ElseIf Dic.exists(x) And Not LCase(Dic(x)) Like "*|" & LCase(y) & "|*" Then
Dic(x) = Dic(x) & "|" & y & "|"
End If
Next Cl
Range("A2:D" & Cells(Rows.Count, "B").End(xlUp).Row).ClearContents
i = 2
For Each Key In Dic
Cells(i, "A") = Split(Dic(Key), "|")(0)
Range(Cells(i, "B"), Cells(i, "C")) = Split(Key, "|")
Cells(i, "D") = Replace(Split(Replace(Dic(Key), "||", ";"), "|")(1), ":", ";")
i = i + 1
Next Key
Set Dic = Nothing
End Sub

antes de

después