Rusty ha un elenco di codici postali in una colonna di un foglio di lavoro. Vorrebbe un modo per “comprimere” i codici in modo che intervalli di valori sequenziali si trovino su una singola riga. Quindi, ad esempio, invece di 35013, 35014 e 35015 che occupano tre righe, apparirebbero su una singola riga come 35013-35015.

Ci sono un paio di modi per farlo, con o senza macro. Sul lato “senza macro” del recinto, ci sono una serie di approcci diversi e tutti prevedono l’uso di colonne aggiuntive per contenere risultati intermedi.

Ad esempio, supponiamo di avere i tuoi dati nella colonna A, a partire dalla cella A2, e che la cella A1 sia vuota (non contiene nemmeno il testo dell’intestazione). In questo caso potresti inserire la seguente formula nella cella B2:

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

Quindi, nella cella C2, inserisci la seguente formula lunga:

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

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

Ora puoi copiare le formule nelle celle B2: C2 nelle rispettive colonne. Ciò che si ottiene nella colonna C è la serie condensata di codici postali. Puoi copiare questi valori, utilizzando Incolla speciale per ignorare le celle vuote, in qualsiasi altro posto desideri.

Se si desidera utilizzare un approccio macro, non sono necessarie colonne intermedie. È possibile scrivere una macro che essenzialmente comprime l’elenco dei codici postali in posizione. La seguente macro scorre qualsiasi intervallo di celle selezionato e crea l’elenco ridotto:

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: _

Se desideri sapere come utilizzare le macro descritte in questa pagina (o in qualsiasi altra pagina dei siti ExcelTips), ho preparato una pagina speciale che include informazioni utili.

Fare clic qui per aprire quella pagina speciale in una nuova scheda del browser.

ExcelTips è la tua fonte di formazione economica su Microsoft Excel.

Questo suggerimento (11977) si applica a Microsoft Excel 2007, 2010, 2013 e 2016.

Puoi trovare una versione di questo suggerimento per la vecchia interfaccia del menu di Excel qui:

Condensing Sequential Values ​​to a Single Row.