Distribuez régulièrement les noms aux lignes basées sur Countif

Question

J'ai des difficultés à écrire un peu de code VBA et je suis à la recherche de suggestions sur la façon de compléter.

Mon jeu de données contiendra une colonne de catégories pouvant être A, B ou C. Le nombre de lignes variera toujours. Une fois que j'ai défini les catégories dans un tableau, je veux faire une boucle et rechercher la valeur par rapport à une table sur un autre onglet mais si la catégorie est C, je dois compter le nombre de lignes contenant C puis distribuer ces lignes à une liste de noms d'employés dans la table. La recherche de la catégorie A & B fonctionne maintenant. Ont été en mesure de compter les lignes avec la catégorie C sur le tableau de données &. Je ne sais pas comment insérer correctement les noms des employés dans les lignes jusqu'au numéro "CntPerStaff", puis passer au nom du prochain employé dans la table.

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 

C'est ce que j'ai jusqu'à présent sur le code countif:

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

Ce n'est pas exactement l'effet que je visais, mais il ne fonctionne pas pour donner une distribution uniforme des lignes aux employés répertoriés dans le tableau. J'ai utilisé le code pour déterminer A & B comme écrit ci-dessus, puis trié cette colonne pour obtenir les lignes vides sur le bas des données avant d'exécuter cette boucle.

'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