Rustyは、ワークシートの列に郵便番号のリストを持っています。彼は、コードを「圧縮」して、値の連続する範囲が1行になるようにする方法を望んでいます。したがって、たとえば、35013、35014、および35015が3行を占める代わりに、35013-35015として単一の行に表示されます。

これを行うには、マクロの有無にかかわらず、いくつかの方法があります。フェンスの「マクロなし」側には、さまざまなアプローチがあり、それらはすべて、中間結果を保持するために追加の列を使用する必要があります。

たとえば、セルA2から始まる列Aにデータがあり、セルA1が空である（ヘッダーテキストすら含まれていない）とします。この場合、セルB2に次の数式を入力できます。

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

次に、セルC2に、次の長い式を入力します。

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

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

これで、セルB2：C2の数式をそれぞれの列にコピーできます。最終的に列Cに表示されるのは、一連の郵便番号を要約したものです。これらの値は、[形式を選択して貼り付け]を使用して空白のセルを無視して、他の任意の場所にコピーできます。

マクロアプローチを使用する場合は、中間列は必要ありません。郵便番号のリストを基本的に折りたたむマクロを作成できます。次のマクロは、選択したセルの範囲をループして、要約リストを作成します。

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

注：

このページ（または_ExcelTips_サイトの他のページ）で説明されているマクロの使用方法を知りたい場合は、役立つ情報を含む特別なページを用意しました。

linkここをクリックして、新しいブラウザタブでその特別なページを開きます。

_ExcelTips_は、費用効果の高いMicrosoftExcelトレーニングのソースです。

このヒント（3853）は、Microsoft Excel 97、2000、2002、および2003に適用されます。Excel（Excel 2007以降）のリボンインターフェイス用のこのヒントのバージョンは、次の場所にあります。

linkシーケンシャル値を単一の行に凝縮する。