Question

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

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所示）

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

结果

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)

从excel中的列表创建“从头到尾”编号的组

3 个答案: