Question

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

我的数据集将包含一列类别，可以是A，B或C.行数总是会有所不同。一旦我将类别设置为数组，我想循环并在另一个选项卡上查找表的值，但如果类别是C，我需要计算包含C的行数，然后将这些行均匀地分配到员工名称列表在表内。 A类和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

这不是我想要的效果，但它确实可以为表中列出的员工提供均匀的行分布。我用这个代码来确定A＆amp; 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

基于Countif将名称均匀分配到行

1 个答案: