总结一下，我需要做的是与这篇文章相反：
换句话说，我在 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 所示）
问问题
1542 次
3 回答
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
于 2014-03-03T21:43:09.500 回答
0
我的快速试用
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
于 2013-04-08T20:14:22.630 回答
0
尝试：
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)
于 2013-04-08T20:19:11.667 回答