Anónimo
Excel. Crear una acción automática
En mi trabajo, cada día, he de coger un listado de Excel como el siguiente:
y dejarlo como aquí:
Como se puede ver, de combinar, en ciertas columnas, una determinadas celdas en función de si se repite el número de la columna C o no y esto lo hago combinando celdas manualmente.
¿Existe alguna fórmula o alguna manera de que el programa me combine las celdas que correspondan de forma automática?
1 Respuesta
De hecho tienes 3 condiciones para combinar las celdas y esas son las tres primeras columnas, en este ejemplo, la combinación se hace comparando el nombre de las empresas, el nombre y el numero de la columna 3 si estas tres comparaciones tienen más de 1 coincidencia las combina en una celda, por cierto para hacer esto es a fuerza una macro
y esta es la macro trabajara segun los datos que encuentre puede ser 1 o 1 millon.
Sub combinar_celdas()
Application.DisplayAlerts = False
Set misdatos = Range("a1").CurrentRegion
With misdatos
filas = .Rows.Count
col = .Columns.Count
Set misdatos = .Rows(2).Resize(filas - 1)
.Sort _
key1:=Range(.Columns(1).Address), order1:=xlAscending, _
key2:=Range(.Columns(2).Address), order2:=xlAscending, _
key3:=Range(.Columns(3).Address), order3:=xlAscending
Set mitabla = .Columns(col + 2).Resize(filas, 1)
matriz = mitabla
For i = 1 To filas
matriz2 = Application.Transpose(Application.Transpose(.Cells(i, 1).Resize(1, 3)))
matriz(i, 1) = Join(matriz2, " ")
Next i
With mitabla
Range(.Address) = matriz
Set unicos = .Columns(4).Resize(filas, 1)
End With
With unicos
.Value = mitabla.Value
.RemoveDuplicates Columns:=1
filas = .CurrentRegion.Rows.Count
For i = 1 To filas
dato = .Cells(i)
cuenta = WorksheetFunction.CountIf(mitabla, dato)
If cuenta > 1 Then
indice = WorksheetFunction.Match(dato, mitabla, 0)
misdatos.Cells(indice, 3).Resize(cuenta, 1).Merge
misdatos.Cells(indice, 3).Resize(cuenta, 1).VerticalAlignment = xlCenter
End If
Next i
End With
End With
mitabla.Clear
unicos.Clear
Set unicos = Nothing: Set mitabla = Nothing
Application.DisplayAlerts = True
End Sub