创build行VBA的范围
我有多行，有时是有序的，有时不是。 在sorting中，我需要创build一个范围，这不是为了复制数字。
事情是，最多的行可以是20。
例如单元格：
1
3
五
6
7
8
9
10
13
14
15
那里将会是：
1
3
5-10
13-15
是否可以编码？
谢谢
假设你的数据以A1 ….开始
所需结果将打印在C列。
尝试使用下面的代码
Sub test() Dim i As Long, lastrow As Long, incre As Long Dim startno As Variant Dim endno As Variant incre = 1 lastrow = Range("A" & Rows.Count).End(xlUp).Row For i = 1 To lastrow If Cells(i, 1) = (Cells(i + 1, 1) - 1) Then startno = Cells(i, 1) Do While Cells(i, 1) = (Cells(i + 1, 1) - 1) endno = Cells(i + 1, 1) i = i + 1 Loop Cells(incre, 3) = "'" & startno & "-" & endno incre = incre + 1 Else Cells(incre, 3) = Cells(i, 1) incre = incre + 1 End If Next i End Sub 
如果你想要使用所有连续范围的地址 ：
Option Explicit Sub main() Dim rangeStrng As String With Worksheets("MyRowsSheet") '<--| change "MyRowsSheet" with your actual sheet name rangeStrng = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeConstants).Areas.Parent.Address(False, False) End With End Sub
如果你只想要行范围，那么你可以使用：
Option Explicit Sub main2() Dim rng As Range Dim rowsRangeStrng As String With Worksheets("MyRowsSheet") '<--| change "MyRowsSheet" with your actual sheet name For Each rng In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).SpecialCells(xlCellTypeConstants).Areas If rng.Rows.Count = 1 Then rowsRangeStrng = rowsRangeStrng & rng.Rows(1).Row & "," Else rowsRangeStrng = rowsRangeStrng & rng.Rows(1).Row & "-" & rng.Rows(rng.Rows.Count).Row & "," End If Next rng End With If rowsRangeStrng <> "" Then rowsRangeStrng = Left(rowsRangeStrng, Len(rowsRangeStrng) - 1) End Sub
如果我正确地理解了你的问题，你不是在寻找一个范围，而是想要一个输出表。 下面的代码应该为您提供。 我的input数字在A列，输出在B列。
Sub sequentials() Dim tws As Worksheet Dim tmpRowA, tmpRowB As Integer Dim seq() As Long Dim frA, frB, lrA As Integer 'firstrow col A, col B, lastrow of data Set tws = ThisWorkbook.Worksheets("Sheet1") frA = 2 frB = 2 lrA = tws.Range("A1000000").End(xlUp).Row 'Input in column A, Output in column B 'Headers in Row 1 ReDim seq(0 To lrA - 1) seq(0) = -2 seq(1) = tws.Range("A" & frA).Value tmpRowA = frA tmpRowB = frB tws.Range("B" & frB & ":B" & lrA).NumberFormat = "@" For r = frA + 1 To lrA If r = 23 Then r = 23 End If With tws seq(r - 1) = .Range("A" & r).Value If seq(r - 1) = seq(r - 2) + 1 Then If r = lrA Then .Range("B" & tmpRowB).Value = .Range("A" & tmpRowA - 1).Value & "-" & seq(r - 1) End If Else If seq(r - 2) = seq(r - 3) + 1 Then .Range("B" & tmpRowB).Value = .Range("A" & tmpRowA - 1).Value & "-" & seq(r - 2) Else .Range("B" & tmpRowB).Value = seq(r - 2) End If tmpRowB = tmpRowB + 1 tmpRowA = r + 1 If r = lrA Then .Range("B" & tmpRowB).Value = seq(r - 1) End If End If End With Next r End Sub
概念validation：
