list - 从excel中的列表创建从头到尾的数字组

Question

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

如何从开始编号和结束编号创建列表

换句话说，我在 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 所示）

Answer 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    

Answer 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

结果

A   B   C
1   1   3
2   6   9
3   12  12
6   33  38
7   44  45
8   55  56
9   66  67
12      
33      
34      
35      
36      
37      
38      
44      
45      
55      
56      
66      
67      

Answer 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)