查找最新的分组答案

【问题标题】：Finding the latest in grouping查找最新的分组
【发布时间】：2014-07-29 00:43:00
【问题描述】：

我有几百个细胞。我想在分组中找到最新的。例如我有以下数据：

233400-003-02
233400-002-03
233400-002-02
233400-002-01
233400-001-04
233400-001-03
233400-001-02
233400-001-01

最后一个数字定义了版本。我只想保留最大数量或最新版本。到目前为止我有

For j = 9 To i Step 1
    Dim Idstring As String

    If Len(Cells(j, 1)) = 13 Then
        Idstring = Left(Cells(j, 1), 10)
        Cells(j, 5) = Idstring
    ElseIf Len(Cells(j, 1)) = 16 Then
        Idstring = Left(Cells(j, 1), 10)
        Cells(j, 5) = Idstring
    ElseIf Len(Cells(j, 1)) = 17 Then
        Idstring = Left(Cells(j, 1), 14)
        Cells(j, 5) = Idstring
    ElseIf Len(Cells(j, 1)) = 20 Then
        Idstring = Left(Cells(j, 1), 14)
        Cells(j, 5) = Idstring
    End If


    If Cells(j, 5) = Cells(j - 1, 5) Then


        If Len(Cells(j, 1)) = 16 Then
            Cells(j, 5).EntireRow.Delete
        ElseIf Len(Cells(j, 1)) = 20 Then
            Cells(j, 5).EntireRow.Delete
        ElseIf Right(Cells(j, 1), 1) < Right(Cells(j + 1, 1), 1) Then
            Cells(j, 5).EntireRow.Delete
        ElseIf Right(Cells(j, 1), 1) > Right(Cells(j + 1, 1), 1) Then
            Cells(j + 1, 5).EntireRow.Delete
            j = j + 1
        End If
    End If

下一个 j

我做错了什么？感谢您的帮助。

【问题讨论】：

标签： vba excel

【解决方案1】：

我认为您在填充 Cells(j-1) 之前与 Cells(j-1) 进行比较。但是，如果我对此有误，您需要在删除行时向后循环遍历该范围，否则 Excel 会丢失您所在的位置。

Public Sub DeleteAllButLatest()

    Dim i As Long

    For i = 9 To 3 Step -1
        If Base(Cells(i, 1).Value) = Base(Cells(i - 1, 1).Value) Then
            Cells(i, 1).EntireRow.Delete
        End If
    Next i

End Sub

Public Function Base(ByVal sCode As String) As String

    Select Case Len(sCode)
        Case 13, 17
            Base = Left(sCode, Len(sCode) - 3)
        Case 16, 20
            Base = Left(sCode, Len(sCode) - 6)
    End Select

End Function

基于您在 A2:A9 中的样本数据。只需要去第 3 行，因为第 2 行必须是好的，所以不需要检查它。我创建了一个函数来返回每个数字的“基数”，以便您可以将当前单元格的基数与其上方的单元格进行比较。如果它们相同，请删除。如果不是，则假定它是最新的。

【讨论】：