Question

我有一份来自我的报告的案例清单，并将案例平均分配给每个学生几乎没有条件 1.学生A只会处理特殊情况。案例＃的len大于6，这是特殊情况，最大学生A可以做的是25个案例。示例：

STUD_Loc 1  STUD_Loc 1  Case ID Len Dup Student Name
ST  TGG E16946-1    8   E16946  Student A
MI  FRE E16946-2    8   E16946  Student A

重置案例可以平等分配给所有其他学生。如果发现重复，应该在任何一行o

ST  ITL D17514  6   D17514  Student B
LA  PBM D17514  6   D17514  Student B

附加示例案例文件。

需要excel formal或VBA来解决它。截至目前我手动完成它需要近3小时。请帮忙

Answer 1

这是您的第一个条件的VBA功能：仅为学生A分配特殊情况（大于6位），也不超过25个。

只有当案例ID位于第一列（A列）并且学生姓名将被放入Excel工作表的第三列（C列）时，以下功能才能正常运行。

注意：您的工作表应如下所示，以便运行以下代码。

您还可以编辑代码以放置您选择的列。例如，把＆＃34; C＆＃34;而不是＆＃34; A＆＃34;对于案例ID（因为案例ID在屏幕截图中的C列中）

Sub Fill_Student_Names()

    ' Count number of cases assigned to Student A
    Count_StudentA = 0

    ' Loop through the Case Ids
    HowFar = Application.WorksheetFunction.CountA(Range("A:A"))
    Dim i As Integer
    For i = 2 To HowFar

        ' Get length of case id
        Length = Len(Range("A" & i).Value)

        ' If length is greater than 6, assign it to Student A
        If Length > 6 And Count_StudentA <= 25 Then

            ' Put Student A in the Student Name column
            Range("C" & i).Value = "Student A"

            ' Increment the count variable
            Count_StudentA = Count_StudentA + 1

        End If

    Next i

End Sub

删除重复行并将重复项放入＆＃34;重复＆＃34;的代码栏（D栏）。

Sub RemoveDuplicates()

    ' Sort the id column in descending order
    ActiveSheet.UsedRange.Sort key1:=Range("A:A"), order1:=xlDescending, Header:=xlYes

    MsgBox ("Sorted")

    ' Loop through the id column and match first six digits of each pair of consecutive ids
    HowFar = Application.WorksheetFunction.CountA(Range("A:A"))
    Dim PrevCell As Range
    Dim ThisCell As Range
    Dim i As Integer
    For i = 3 To HowFar

        Set ThisCell = ActiveSheet.Cells(i, 1)

        Set PrevCell = ActiveSheet.Cells(i - 1, 1)

        ' Compare the cell values
        If (Left(PrevCell.Value, 6) = Left(ThisCell.Value, 6)) Then

            ' Take the id and put it in the duplicates column
            ActiveSheet.Cells(i - 1, 4).Value = ThisCell.Value

            'MsgBox ("Deleting row " & i)

            ' Delete this row
            Rows(i).Delete

            ' Decrease i by 1
            i = i - 1

            ' Decrease the total number of rows by 1
            HowFar = HowFar - 1

            ' Check if HowFar has not become zero or negative
            If (HowFar <= 0) Then
                Exit For
            End If

        End If

    Next i

End Sub

向学生分配数据

1 个答案: