Rusty在工作表的列中有一个邮政编码列表。他想要一种“压缩”代码的方法,以便将值的连续范围放在一行上。因此,例如,它们不会代替35013、35014和35015占据三行,而是以35013-35015出现在单行中。

有两种方法可以使用-带有或不带有宏。在栅栏的“没有宏”一侧,有许多不同的方法,并且所有方法都涉及使用附加列来保存中间结果。

例如,假设您将数据存储在A列中(从单元格A2开始),并且单元格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_网站上的任何其他页面)中描述的宏,我准备了一个特殊页面,其中包含有用的信息。

_ExcelTips_是您进行经济高效的Microsoft Excel培训的来源。

本技巧(3853)适用于Microsoft Excel 97、2000、2002和2003。可以在以下功能区中为Excel的功能区界面(Excel 2007及更高版本)找到本技巧的版本: