Vba 根据Countif将名称均匀分布到行中

我在编写VBA代码时遇到了一些问题，正在寻找有关如何完成的建议

我的数据集将包含一列类别，可以是a、B或C。行的数量将始终不同。一旦我将类别设置为一个数组，我希望循环并根据另一个选项卡上的表查找值，但如果类别是C，我需要计算包含C的行数，然后将这些行均匀地分布到表中的员工姓名列表中。类别A和B的查找现在正在工作。已经能够在数据集和表上计算类别为C的行。不确定如何将员工姓名正确插入到“CntPerStaff”编号之前的行中，然后转到表中的下一个员工姓名

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

这是我到目前为止对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)

---

这并不是我想要的效果，但它确实可以为表中列出的员工提供均匀的行分布。我使用代码来确定上面写的A和B，然后排序该列以在运行这个循环之前获得数据底部的空白行。

'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

“设置表格和副本名称”
设置源=工作表（“表格”）。列表对象（“类别ID”）
有来源
.Range.AutoFilter字段：=1，准则1:=“C”
SourceDataRows=.ListColumns（2）.DataodyRange.SpecialCells（xlCellTypeVisible）.复制
以
'循环以粘贴名称
当x