Question

我在使用某些excel vba时遇到麻烦，甚至不确定是否可以完成。我一直在寻找解决方案已有一段时间了。我已经附加了图像，以使其易于理解，因为用代码编写它很复杂。

这是一个问题：

图像1显示默认状态。 1，我需要按黄色单元格对部分（边框单元格）进行排序。结果在image2上。如果我获得双倍职位，则需要删除该行（仅行）（图3）

一些帮助：黄色单元格始终是4个字符单元格如果C单元格为4个字符单元格，则类别单元格始终为F 如果C单元格为4个字符单元格，则名称单元格始终为空构建，绘制，定位等始终位于第8行

我设法获得了代码来选择每个“部分”，但是我很确定这是错误的方法。

是否可以使用excel vba做到这一点？

非常感谢你，最好的祝福，马里奥

ActiveSheet.Range("A25000").Select
Selection.End(xlUp).Select
ActiveSheet.Range(Selection, "A9").Select
Set ColumnaA = Selection

For Each Cell In ColumnaA

If IsEmpty(Cell.Offset(0, 6).Value) And Not IsEmpty(Cell.Offset(2, 6).Value) Then
    Cell.Offset(1, 6).Select
    Selection.End(xlDown).Select
    Selection.Offset(0, 5).Select
    Set section = ActiveSheet.Range(Selection, Cell)
End If

If IsEmpty(Cell.Offset(0, 6).Value) And IsEmpty(Cell.Offset(2, 6).Value) Then
    Cell.Offset(0, 6).Select
    Selection.End(xlDown).Select
    Selection.Offset(0, 5).Select
    Set section = ActiveSheet.Range(Selection, Cell)
End If

Next Cell

Image1

Image2

Image3

Answer 1

我同意@tehscript的观点，即构建composite key是最简单的方法。因此，我们将要：

建立几个助手列，
在其中之一中创建复合键，以便我们可以正确地对行进行排序，
对行进行排序，
删除底部的重复项，
摆脱助手列

组合键将采用以下形式：

XXXX-SS-LLL

其中“ XXXX”是4位数字的位置，“ SS”是给定列表中特定位置的“系列”或出现（从00开始，依次上升），“ LLL”是给定子项目的项目编号。因此，从您的“图片1”开始，在第40行中，我们将得到：

0114-01-002

（0114：位置，01：这是我们列表中的第二个0114（第一个出现在第24行中，002：这个事件下的第二个出现0114）

如果您有任何疑问，请告诉我！

Sub sortStuff()
    Dim ws As Worksheet, totalRange As Range, arr() As Variant, lastRow As Long
    Dim index As Long, indexes() As Variant, dict As Object
    Dim position As String, lastPosition As String, compositeKey As String, category As String
    Dim countRowsToDelete As Long

    'our dictionary to manage multiple instances of the same position
    Set dict = CreateObject("Scripting.Dictionary")

    countRowsToDelete = 0

    Set ws = Application.ActiveSheet
    'we add some columns to the right of our data here
    'column 13 will be for a composite key, and 14 will be for marking rows to delete
    ws.Range(ws.Cells(1, 13), ws.Cells(1, 14)).EntireColumn.Insert Shift:=xlToRight
    lastRow = ws.Cells(ws.UsedRange.Rows.count + ws.UsedRange.Row, 1).End(xlUp).Row
    'grabs the whole range that we're interested in
    Set totalRange = ws.Range(ws.Cells(9, 1), ws.Cells(lastRow, 14))
    'builds a 2-D array of the values of our range
    arr = totalRange.Value2

    lastPosition = ""
    For index = 1 To UBound(arr, 1)
        position = arr(index, 3)
        category = arr(index, 4)
        'the default for this column is "0", which will mark this row not to be deleted
        arr(index, 14) = 0
        'Checking if this is a "master" row
        If category = "F" Then
            'If it is, check to see if we already have this position somewhere on the sheet
            If dict.Exists(position) Then
                'if we do, increment the "series" of the particular row
                dict(position) = dict(position) + 1
                'if we already have this position, this is a duplicate, so mark it for deletion
                arr(index, 14) = 1
                'increment the number of rows to delete
                countRowsToDelete = countRowsToDelete + 1
            Else
                'we've not come across this position before, so add it to the dictionary
                Call dict.Add(position, 0)
            End If
            'we're building a "composite key" for each row
            compositeKey = position & "-" & Format(CStr(dict(position)), "00") & "-000"
            'this lets us use the "master" position for the subitems in the list
            lastPosition = position
        Else
            'if this is not a "master" row, the 4 character position is going to come from lastPosition
            compositeKey = lastPosition & "-" & Format(CStr(dict(lastPosition)), "00") & "-" & Format(position, "000")
        End If
        'place our composite key in the array
        arr(index, 13) = compositeKey
    Next

    'we've manipulated the array, and are ready to place it back on the spreadsheet
    totalRange.Value2 = arr

    'now that the data is back on the sheet, we can use the in-built excel sort functions
    'here, we sort first by column 14, which will leave the repeats to delete at the bottom
    'we then sort by column 13, which is our composite key
    With ws.Sort
        .SortFields.Clear
        Call .SortFields.Add(totalRange.Columns(14), xlSortOnValues, xlAscending)
        Call .SortFields.Add(totalRange.Columns(13), xlSortOnValues, xlAscending)
        .SetRange totalRange.Offset(-1, 0).Resize(totalRange.Rows.count + 1)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

    Dim deleteStartRow As Long
    If countRowsToDelete > 0 Then
        'figure out the start of the rows to be delete for duplicates
        deleteStartRow = lastRow - countRowsToDelete + 1
        'delete the repeat entries
        Call ws.Range(ws.Cells(deleteStartRow, 1), ws.Cells(lastRow, 1)).EntireRow.Delete(xlUp)
    End If
    'delete the helper columns
    Call ws.Range(ws.Cells(1, 13), ws.Cells(1, 14)).EntireColumn.Delete(xlLeft)

End Sub

Excel VBA按第n行排序并删除重复项

1 个答案: