Verteilen Sie die Namen gleichmäßig auf Zeilen basierend auf Countif

Question

Ich habe Probleme beim Schreiben ein wenig VBA-Code und bin auf der Suche nach Vorschlägen, wie zu vervollständigen.

Mein Datensatz enthält eine Spalte mit Kategorien, die A, B oder C sein können. Die Anzahl der Zeilen wird immer variieren. Sobald ich die Kategorien auf ein Array setze, das ich durchlaufen möchte, suche ich den Wert für eine Tabelle auf einer anderen Registerkarte, aber wenn die Kategorie C ist, muss ich die Anzahl der Zeilen zählen, die C enthalten, und diese Zeilen gleichmäßig an eine Liste von Mitarbeiternamen verteilen innerhalb der Tabelle. Die Suche nach Kategorie A & B funktioniert jetzt. In der Tabelle & konnten Zeilen mit Kategorie C gezählt werden. Sie wissen nicht, wie Sie die Namen der Mitarbeiter korrekt in Zeilen bis zur "CntPerStaff" -Nummer einfügen und dann in der Tabelle auf den nächsten Angestelltennamen wechseln.

Dim LastRow As Long, i As Long 
Dim Arr1 As Variant, Arr2 As Variant 

'Finds last row in data set 
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row 

'Set data columns to arrays 
    Arr1 = Range("AP2:AP" & LastRow).Value 'Category 
    Arr2 = Range("AQ2:AQ" & LastRow).Value 'Employee 

    For i = 1 To UBound(Arr1) 

    If Arr1(i, 1) = "A" Then 
     Arr2(i, 1) = Application.WorksheetFunction.VLookup("A", Worksheets("Tables").Range("CATEGORYID"), 2, False) 
    ElseIf Arr1(i, 1) = "B" Then 
     Arr2(i, 1) = Application.WorksheetFunction.VLookup("B", Worksheets("Tables").Range("CATEGORYID"), 2, False) 
    Else 'Need to insert countif functionality 
    End If 
Next i 

'Place employee name array into spreadsheet 
    Range("AQ2").Resize(UBound(Arr2, 1), 1).Value = Arr2 

Das ist, was ich bisher auf dem countIf Code haben:

Dim Count As Variant, CntPerStaff As Variant, Arr1 As Variant 
Dim LastRow As Long, i As Long, Cnt As Long, Staff As Long, CntStart As Long 

'Finds last row in data set 
    LastRow = Cells(Rows.Count, "A").End(xlUp).Row 
    Cnt = WorksheetFunction.CountIf(Range("AP2:AP" & LastRow), "C") 
    Staff = WorksheetFunction.CountIf(Worksheets("Tables").Range("CATEGORYID"), "C") 
    CntPerStaff = WorksheetFunction.RoundUp(Cnt/Staff, 0) 

Example of Table and Data (red is info which macro will output)

Answer 1

Dies ist nicht gerade der Effekt, den ich für vorging aber es funktioniert eine gleichmäßige Verteilung geben von Zeilen an die in der Tabelle aufgeführten Mitarbeiter. Ich benutzte den Code für die Bestimmung A & B wie oben beschrieben, dann sortiert diese Spalte, um die leeren Zeilen am unteren Rand der Daten vor dem Ausführen dieser Schleife zu erhalten.

'Set table and copy names 
Set Source = Worksheets("Tables").ListObjects("CATEGORYID")  
    With Source 
     .Range.AutoFilter Field:=1, Criteria1:="C" 
     SourceDataRows = .ListColumns(2).DataBodyRange.SpecialCells(xlCellTypeVisible).Copy 
    End With 

'Loop to paste names 
    Do While x < LastRow 
     x = Cells(Rows.Count, "AQ").End(xlUp).Row + 1 
      With Worksheets("Data").Range("AQ" & Rows.Count).End(xlUp).Offset(1) 
       .PasteSpecial Paste:=xlPasteColumnWidths 
       .PasteSpecial Paste:=xlPasteValues 
      End With 
     Loop 

'Remove any names which pasted past the last row of data 
    With ActiveSheet 
     .Range("A" & LastRow + 1 & ":AQ" & .Rows.Count).ClearContents 
    End With