エクセルワークシートの重複ライダーを分離

Question

私が設計した4Dバレルレーシングジャックポット用のワークブックがあります。重複したライダーが少なくとも10行で区切られていることを確認できるようにすることを除いて、すべてが完璧です。これは可能ですか？もしそうなら、どうですか？

私は重複を見つけて取り除く方法を知っています。それは問題ではありません。私はちょうどお互いからそれらを分離したい。

ありがとうございます！

Answer 1

保留キューへの要素の再割り当てに基づいて、以下の例を参照してください。

：ここ

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に設定分離する行の数である列Bにそれがプロセスを、カラムAからの入力データを受け取り、出力結果