从excel中的列表创建从头到尾的数字组答案

【问题标题】：Create Groups of Beginning to End numbers from a list in excel从excel中的列表创建从头到尾的数字组
【发布时间】：2013-04-08 19:14:50
【问题描述】：

总结一下，我需要做的是与这篇文章相反：

How to create a list from beginning number and end number

换句话说，我在 A 列中有一个数字列表，我希望将它们分组在从 B 和 C 列的开始到结束数字的范围内即

column A
1
2
3
6
7
8
25
28
29
30

（执行VBA代码后）

Column B  Column C
   1         3
   6         8
   25        25
   28        30

如果值不能被分组，它将是相同的开始和结束编号（如上例中的 N° 25 所示）

【问题讨论】：

您解释哪些数字组合在一起的部分在哪里？看起来你正在做每第三个数字，但然后“25”就会把它扔掉。因此，请解释它们是如何分组的。
只是好奇...What have you tried?
@David：我认为操作想要每组连续数字的开始和结束，例如1-3、6-8、25、28-30。
@glh ahhh 你看到了我没有看到的模式:)
问题是我们只认为给定的模式适用于此，我们没有证据证明这一点。该操作也没有指定模式。

标签： list excel grouping vba

【解决方案1】：

Tarmo Elfving 的想法是正确的，但只能处理高达 32k 的数字。如果您改为将 Integer 更改为 Long，脚本可以处理更大的数字，同时消除许多人看到的“溢出”错误。

Sub Ranges()
With ActiveWorkbook.Worksheets("Sheet1")
    Dim r As Long
    Dim beg As Long
    Dim en As Long
    i = 1
    r = 1
    beg = .Cells(1, 1).Value
    en = beg
    While .Cells(i, 1).Value
        If .Cells(i, 1).Value > en + 1 Then
            .Cells(r, 2).Value = beg
            .Cells(r, 3).Value = en

            beg = .Cells(i, 1).Value
            en = beg
            r = r + 1
        Else
            en = .Cells(i, 1).Value
        End If
        i = i + 1
    Wend
    .Cells(r, 2).Value = beg
    .Cells(r, 3).Value = en
End With
End Sub

结果

A       B       C
10001   10001   10003
10002   10006   10009
10003   100012  100012
10006   100033  100038
10007   100044  100045
10008   100055  100056
10009   100066  100067
100012      
100033      
100034      
100035      
100036      
100037      
100038      
100044      
100045      
100055      
100056      
100066      
100067

【讨论】：

【解决方案2】：

我的快速试用

Sub Ranges()
With ActiveWorkbook.Worksheets("Sheet1")
    Dim r As Integer
    Dim beg As Integer
    Dim en As Integer
    i = 1
    r = 1
    beg = .Cells(1, 1).Value
    en = beg
    While .Cells(i, 1).Value
        If .Cells(i, 1).Value > en + 1 Then
            .Cells(r, 2).Value = beg
            .Cells(r, 3).Value = en

            beg = .Cells(i, 1).Value
            en = beg
            r = r + 1
        Else
            en = .Cells(i, 1).Value
        End If
        i = i + 1
    Wend
    .Cells(r, 2).Value = beg
    .Cells(r, 3).Value = en
End With
End Sub

结果

【讨论】：

嗨，我尝试在一长串值（几乎是整个列）上使用它，过了一段时间它确实给了我一些结果并且像一个魅力一样工作，但突然它告诉我“运行Time Error '6': Overflow" 没有解决这个问题，有什么建议吗？
是的，我认为如果列填充到最后并且当循环尝试查找工作表最大行之外的值时，它会做一些有趣的事情。 “While”循环在递增时可以使用另一个条件来检查“i”的最后值。如果超出范围，则退出循环。

【解决方案3】：

试试：

s as range
Set s = range("A1:A10")
r as long
r = 1
p as long
p = s.cells(1,1).value

for each c in s 

    'add start of range
    if c-1 <> p then

        'end last range
        If r>1 then

            cell(r, 3) = p
            r=r+1

        end if

        'start new range
        Cells(r, 2)=c

    End if
    p = c

Loop
Cells(r, 3)=s.cells(s.count, 1)

【讨论】：