在Excel工作表中单独重复的骑手

Question

我有一个我设计的4D桶式赛车累积奖金的练习册。一切都很完美，除了我希望能够确保重复的骑手被分开至少10行。这可能吗？如果是这样，怎么样？

我知道如何找到并摆脱重复。那不是问题。我只想将它们彼此分开。

谢谢！

Answer 1

根据元素重新分配到保留队列，查看下面的示例。它从A列获取输入数据，处理它，并将结果输出到B列。

Option Explicit

Sub Separate()

    Dim nSeparate As Long
    Dim cqHolds As Object
    Dim qInput As Object
    Dim qResult As Object
    Dim i As Long
    Dim nLength As Long
    Dim Content As Variant
    Dim sqName As Variant
    Dim sqTarget As Variant

    ' Set number of rows to separate
    nSeparate = 4

    ' Init objects
    Set cqHolds = CreateObject("Scripting.Dictionary")
    Set qInput = CreateObject("System.Collections.Queue")
    Set qResult = CreateObject("System.Collections.Queue")

    ' Push data from the worksheet column A into input queue
    i = 1
    Do
        Content = ThisWorkbook.Sheets("Data").Cells(i, 1).Value
        If Content = "" Then Exit Do
        qInput.Enqueue Content
        i = i + 1
    Loop

    ' Reallocate input queue elements into hold queues
    Do While qInput.Count > 0
        ' Pull one element from input queue
        Content = qInput.Dequeue
        ' Create hold queue for the element if not exists
        If Not cqHolds.Exists(Content) Then Set cqHolds(Content) = CreateObject("System.Collections.Queue")
        ' Push element into hold queue
        cqHolds(Content).Enqueue Content
        ' Push nSeparate empty trailing places into hold queue
        For i = 1 To nSeparate
            cqHolds(Content).Enqueue ""
        Next
    Loop

    ' Retrieve elements from hold queues into result queue
    Do
        ' Search longest hold queue with non-empty element on exit
        nLength = 0
        For Each sqName In cqHolds
            If cqHolds(sqName).Peek <> "" And cqHolds(sqName).Count > nLength Then
                nLength = cqHolds(sqName).Count
                sqTarget = sqName
            End If
        Next
        ' Target queue not found
        If nLength = 0 Then Exit Do
        ' Pull one empty place from each hold queue
        For Each sqName In cqHolds
            If cqHolds(sqName).Peek = "" Then cqHolds(sqName).Dequeue
            If cqHolds(sqName).Count = 0 Then cqHolds.Remove sqName
        Next
        ' Pull element from target queue and push into result queue
        qResult.Enqueue cqHolds(sqTarget).Dequeue
        If cqHolds(sqTarget).Count = 0 Then cqHolds.Remove sqTarget
    Loop

    ' Force push remaining in hold queues elements into result queue
    nLength = qResult.Count
    Do While cqHolds.Count > 0
        For Each sqName In cqHolds
            Content = cqHolds(sqName).Dequeue
            If Content <> "" Then qResult.Enqueue Content
            If cqHolds(sqName).Count = 0 Then cqHolds.Remove sqName
        Next
    Loop
    If qResult.Count > nLength Then MsgBox "Can't arrange " & (qResult.Count - nLength) & " last elements"

    ' Pull data from result queue into the worksheet column B
    i = 1
    Do While qResult.Count > 0
        ThisWorkbook.Sheets("Data").Cells(i, 2).Value = qResult.Dequeue
        i = i + 1
    Loop

End Sub

以下是代码测试的示例，要分隔的行数设置为4：