Rusty tiene una lista de códigos postales en una columna de una hoja de trabajo. Le gustaría una forma de «comprimir» los códigos de modo que los rangos secuenciales de valores estén en una sola fila. Entonces, por ejemplo, en lugar de 35013, 35014 y 35015 ocupan tres filas, aparecerían en una sola fila como 35013-35015.

Hay un par de formas de hacerlo, con o sin macros. En el lado «sin macros» de la valla, hay una serie de enfoques diferentes, y todos implican el uso de columnas adicionales para mantener resultados intermedios.

Por ejemplo, supongamos que tiene sus datos en la columna A, comenzando en la celda A2, y que la celda A1 está vacía (ni siquiera tiene texto de encabezado). En este caso, podría ingresar la siguiente fórmula en la celda B2:

=IF(NOT(A2-A1=1),A2,IF(A3-A2=1,B1,A2))

Luego, en la celda C2, ingrese la siguiente fórmula larga:

=IF(NOT(A3-A2=1),IF(A2-A1=1,TEXT(B1,"00000")

&" - "&TEXT(B2,"00000"),TEXT(A2,"00000")),"")

Ahora puede copiar las fórmulas en las celdas B2: C2 en sus respectivas columnas. Lo que terminas en la columna C es la serie condensada de códigos postales. Puede copiar estos valores (utilizando Pegado especial para ignorar las celdas en blanco) en cualquier otro lugar que desee.

Si desea utilizar un enfoque macro, no se necesitan columnas intermedias. Se puede escribir una macro que esencialmente colapsa la lista de códigos postales en su lugar. La siguiente macro recorre cualquier rango de celdas que haya seleccionado y crea la lista condensada:

Sub CombineValues()

Dim rng As Range     Dim rCell As Range     Dim sNewArray() As String     Dim x As Long     Dim y As Long     Dim sStart As String     Dim sEnd As String

Set rng = Selection     sStart = rng.Cells(1)

sEnd = sStart     y = 1     For x = 1 To rng.Count - 1         If rng.Cells(x + 1) - _           rng.Cells(x) > 1 Then  'End             ReDim Preserve sNewArray(1 To y)

If sStart = sEnd Then                 sNewArray(y) = sStart             Else                 sNewArray(y) = sStart & "-" & sEnd             End If             sStart = rng.Cells(x + 1)

y = y + 1         End If         sEnd = rng.Cells(x + 1)

ReDim Preserve sNewArray(1 To y)

If sStart = sEnd Then             sNewArray(y) = sStart         Else             sNewArray(y) = sStart & "-" & sEnd          End If     Next     rng.ClearContents     For x = 1 To y         rng.Cells(x) = "'" & sNewArray(x)

Next     Set rng = Nothing     Set rCell = Nothing End Sub

_Nota: _

Si desea saber cómo usar las macros descritas en esta página (o en cualquier otra página de los sitios ExcelTips), he preparado una página especial que incluye información útil.

link: / excelribbon-ExcelTipsMacros [Haga clic aquí para abrir esa página especial en una nueva pestaña del navegador].

ExcelTips es su fuente de formación rentable en Microsoft Excel.

Este consejo (11977) se aplica a Microsoft Excel 2007, 2010, 2013 y 2016.

Puede encontrar una versión de este consejo para la interfaz de menú anterior de Excel aquí:

link: / excel-Condensing_Sequential_Values_to_a_Single_Row [Condensing Sequential Values ​​to a Single Row].