尝试根据定义的条件将数据从一张纸拉到另一张纸

时间:2018-11-11 21:27:02

标签: excel vba

我是Vba和Excel整体上的新手。我有两个工作表(工作表1和工作表2):

表1 包含名称(全名)和评分(分数)之类的信息。每个名称都有一个与之相关的等级。

第2张具有代表成绩范围的单元格。我试图将符合一定等级的员工的姓名拉到各自的框中。

示例-如果John Doe和Jane Doe在表1上的等级为“超过A”。表2的名称应列在“ Exceeds A”字段名称下的同一列中。

我希望我对此解释得足够好。为了更好地理解,我附上了范围的图片:

Sheet 2 Range

1 个答案:

答案 0 :(得分:0)

Sub Grades()

    Dim rng As Range, rngGrades As Range, cll As Range
    Dim i As Integer, j As Integer, iLastCell As Integer

    ' Assuming Sheet2 is set up in the following format:
    ' Grade | Grade | Grade
    '       |       |
    ' Grade | Grade | Grade
    '       |       |
    ' Grade | Grade | Grade
    '       |       |
    ' Can be adjusted if different
    Set rng = Sheets("Sheet2").Range("A1:C6")

    ' It's not specified how the data is structured on Sheet1
    ' Assuming that names are in column A and grades in column B
    iLastCell = Sheets("Sheet1").Range("A1").SpecialCells(xlCellTypeLastCell).Column

    With Sheets("Sheet1")
        Set rngGrades = .Range(.Cells(2, 2), (.Cells(2, iLastCell)))
    End With

    For i = 1 To 5 Step 2
        For j = 1 To 3
            For Each cll In rngGrades
                If cll.Value2 = rng(i, j) Then
                    rng(i + 1, j).Value2 = rng(i + 1, j).Value2 & vbLf & Sheets("Sheet1").Cells(1, cll.Column)
                End If
            Next
        Next
    Next

End Sub