Como combinar celdas con macro
Tengo un macro que combina celdas con un ejemplo que encontre en este medio, el tema que conbina muy bien la columna 1 a partir de A7, pero también quiero que combine los valores repetidos en la columna 6 a partir de celda F7
Adjunto el código que combina los valores repetidos en en A7, quisiera saber como seria el buccle para que también lo haga en F7
Sub ejemplo() 'Por Luis Mondelo Application.DisplayAlerts = False Do While ActiveCell.Value <> "" valor = ActiveCell contarsi = Application.WorksheetFunction.CountIf(Columns(6), valor) If contarsi > 1 Then Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row + contarsi - 1, 6)).Merge End If ActiveCell.Offset(1, 0).Select Loop End Sub
Imagen donde hay valores repetidos en F7 que también se deben combinar.
Su soporte.
Quedaría así:
Sub ejemplo() 'Por Luis Mondelo Application.DisplayAlerts = False Do While ActiveCell.Value <> "" valor = ActiveCell contarsi = Application.WorksheetFunction.CountIf(Columns(6), valor) If contarsi > 1 Then Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row + contarsi - 1, 1)).Merge Range(Cells(ActiveCell.Row, 6), Cells(ActiveCell.Row + contarsi - 1, 6)).Merge End If ActiveCell.Offset(1, 0).Select Loop End Sub
Hola Victor:
Gracias por por la ayuda, sabes el código funciona bien, combina las celdas, pero hay algo que yo no especifique, ojala se pueda mejorar.
Los pedidos por almacén se basan en números de entregas, y una entrega puede tener varias tiendas.
Te paso la foto como debería quedar cuando se ejecuta la macro, y en la parte derecha como lo esta haciendo.
Notaras en la imagen que la entrega 1529393228 - 1529393229 pertenecen a la tienda 102 JOCKEY PLAZA, seria la forma correcta de combinar.
Lo que hace con el código es que la tienda 102 solo la pone en la entrega 1529393228 y se borra la 1529393229.
Ojala con una condición si se pueda mejorar.
Creo que así funcionará como deseas:
Sub ejemplo() 'Por Luis Mondelo Application.DisplayAlerts = False Cells(7, 1).Activate Do While ActiveCell.Value <> "" valor = ActiveCell f = ActiveCell.Row valor2 = Cells(f, 6) contarsi = Application.WorksheetFunction.CountIf(Columns(1), valor) If contarsi > 1 Then contarsi2 = Application.WorksheetFunction.CountIf(Columns(6), valor2) If contarsi2 > 1 Then Range(Cells(ActiveCell.Row, 1), Cells(ActiveCell.Row + 1, 1)).Merge Range(Cells(ActiveCell.Row, 6), Cells(ActiveCell.Row + 1, 6)).Merge End If End If ActiveCell.Offset(1, 0).Select Loop End Sub
1 respuesta más de otro experto
Te anexo la macro
Sub ejemplo()
'Act.Por.Dante Amor
Application.DisplayAlerts = False
For i = 7 To Range("A" & Rows.Count).End(xlUp).Row
contarsi = Application.WorksheetFunction.CountIf(Columns(1), Cells(i, "A"))
If contarsi > 1 Then
Range(Cells(i, "A"), Cells(i + contarsi - 1, "A")).Merge
Range(Cells(i, "F"), Cells(i + contarsi - 1, "F")).Merge
End If
Next
MsgBox "fin"
End Subsal u dos