以下是我的Excel数据的摘录
A 20160101
A 20160104
A 20160105
A 20160106
A 20160107
AA 20160108
AA 20160111
AA 20160112
AA 20160113
AA 20160114
AA 20160115
AA 20160118
AB 20160119
AB 20160120
AB 20160121
AB 20160122
AB 20160125
AB 20160126
AB 20160127
AB 20160128
就像我有超过10,000行
我正在尝试打印每个组的名称，第一个日期，最后日期，例如
a 20160101 20160107
aa 20160108 20160118
ab 20160119 20160128
我的代码
Sub stock_1():
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
for i = 2 To LastRow
If Cells(i + 1, 1).Value <> Cells(i, 1).Value Then
Set MyRange = Range("a" & i)
LastRow_1 = MyRange.Row + MyRange.Rows.Count - 1
firstRow = MyRange.row
end sub
我得到每组的最后一行，但没有获得每组的第一行。请检查并提出建议
删除/添加行时的技巧是，您需要从结尾（最后一行到第一行）开始循环，因为否则添加/删除行会更改行计数，您的循环计数错误。
以下是它的工作原理：
它开始从结束lRow向后循环到fRow开头。它记住该行的值lVal并删除连续的行，直到A列中的值发生变化，然后将lVal写入C列，记住下一个lVal并继续。
Option Explicit
Public Sub CombineConsecutiveValues()
Dim ws As Worksheet
Set ws = ActiveSheet 'better define the workbook ThisWorkbook.Worksheets("Sheet1")
Dim lRow As Long 'find last row
lRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim lVal As Variant 'remember last value (stop value)
lVal = ws.Cells(lRow, "B").Value
Const fRow As Long = 2 'define first data row
Dim i As Long
For i = lRow To fRow Step -1 'loop from last row to first row backwards
If i <> fRow Then 'if we are on the first row there is no value before
If ws.Cells(i, "A").Value = ws.Cells(i - 1, "A").Value Then 'if current value is same as one before
ws.Rows(i).Delete 'delete current row
Else
ws.Cells(i, "C").Value = lVal 'write stop value in column B
lVal = ws.Cells(i - 1, "B").Value 'remember next new stop value
End If
Else
ws.Cells(i, "C").Value = lVal 'write stop value in column B (on first row)
End If
Next i
End Sub
你可以expolit字典：
Option Explicit
Sub main()
Dim vals As Variant
Dim iVal As Long
vals = Application.Transpose(Range("A1", Cells(Rows.Count, 1).End(xlUp)).Value)
With New Scripting.Dictionary
For iVal = 1 To UBound(vals)
.Item(vals(iVal)) = iVal
Next
Range("A1").Offset(0, 2).Resize(, 3) = Array(.Keys(0), Range("B1"), Range("B1").Offset(.Item(.Keys(0)) - 1))
For iVal = 1 To UBound(.Keys)
Range("A1").Offset(iVal, 2).Resize(, 3) = Array(.Keys(iVal), Range("B1").Offset(IIf(iVal = 0, 0, .Item(.Keys(iVal - 1)))), Range("B1").Offset(.Item(.Keys(iVal)) - 1))
Next
End With
End Sub
只需添加对“Microsoft Scripting Runtime”库的引用（在VBA IDE中单击Tools-> References - > scroll listbox并选择“Microsoft Scripting Runtime” - >单击OK）
实际上，这样一种方法可以加快速度：
IF-Then-Else块这是你的代码的修改版本（使用ption Explicit和declre所有变量！）
Option Explicit
Sub stock_1()
Dim LastRow As Long, i As Long, StartDate As String, EndDate As String, CellValue As String, Letters As String
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
CellValue = Cells(1, 1).Value
Letters = Left(CellValue, InStr(1, CellValue, " ") - 1)
StartDate = Right(CellValue, Len(CellValue) - InStr(1, CellValue, " ") + 1)
For i = 2 To LastRow
CellValue = Cells(i, 1).Value
If Letters <> Left(CellValue, InStr(1, CellValue, " ") - 1) Then
Cells(i - 1, 2).Value = Letters
Cells(i - 1, 3).Value = StartDate
Cells(i - 1, 4).Value = EndDate
StartDate = Right(CellValue, Len(CellValue) - InStr(1, CellValue, " ") + 1)
Else
EndDate = Right(CellValue, Len(CellValue) - InStr(1, CellValue, " ") + 1)
End If
Letters = Left(CellValue, InStr(1, CellValue, " ") - 1)
Next
Cells(i - 1, 2).Value = Letters
Cells(i - 1, 3).Value = StartDate
Cells(i - 1, 4).Value = EndDate
End Sub
试试这个代码
Sub Test()
Dim a As Variant
Dim r As Range
Dim i As Long
Dim s As Long
Dim k As Long
With Sheets("Sheet1")
With .Range("A1:B" & .Cells(Rows.Count, 1).End(xlUp).Row + 1)
a = .Value: s = 1
For i = LBound(a) To UBound(a) - 1
If a(i, 1) <> a(i + 1, 1) Then
Set r = .Range("A" & s).Resize(i - s + 1)
k = k + 1
.Range("D" & k).Value = r(1).Value
.Range("E" & k).Value = r(1).Offset(, 1).Value
.Range("F" & k).Value = r(r.Rows.Count).Offset(, 1).Value
s = i + 1
End If
Next i
End With
End With
End Sub
我建议将数据读入数组，然后将所需的值放入类似的字典中
Option Explicit
Sub GetData()
Dim rg As Range
Dim vDat As Variant
Dim i As Long, nextIndex As Long, prevIndex As Long
Dim dict As Scripting.Dictionary
Set rg = Range("A1:B20")
Set dict = New Scripting.Dictionary
vDat = rg
nextIndex = LBound(vDat) + 1
prevIndex = LBound(vDat) - 1
For i = LBound(vDat) To UBound(vDat)
If i = LBound(vDat) Then
dict.Add vDat(i, 1), vDat(i, 2)
End If
If nextIndex <= UBound(vDat) Then
If vDat(nextIndex, 1) = vDat(i, 1) Then
Else
dict(vDat(i, 1)) = dict(vDat(i, 1)) & ";" & vDat(i, 2)
End If
End If
If prevIndex >= LBound(vDat) Then
If vDat(prevIndex, 1) = vDat(i, 1) Then
Else
dict.Add vDat(i, 1), vDat(i, 2)
End If
End If
If nextIndex > UBound(vDat) Then
dict(vDat(i, 1)) = dict(vDat(i, 1)) & ";" & vDat(i, 2)
'Exit For
End If
nextIndex = nextIndex + 1
prevIndex = prevIndex + 1
Next i
Dim key As Variant
For Each key In dict.Keys
Debug.Print key, dict(key)
Next key
End Sub