均勻分佈的名稱基於COUNTIF

Question

我無法寫一點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) 

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

Answer 1

這不正是我要的效果，但它確實工作給予均勻分佈的行列入表中列出的員工。我使用的代碼，用於確定與上述寫入甲& 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