根据输入的课程名称查找与之匹配的教师姓名

564511498

根据输入的课程名称查找与之匹配的教师姓名，最后“课程名称”与“教师姓名”合在一起显视在单元格内。见附件

mineshine

使用Change事件，二维数组，仅供参考。

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ct(6, 6)
Dim i As Integer
Dim c, d As Range
If Target.Row > 2 And Target.Row < 9 And Target.Column > 1 And Target.Column < 8 Then
    For i = 1 To 6
        For j = 1 To 6
            ct(i, j) = Cells(i + 2, j + 13)    '二维数组 (科目,年级)=教师
        Next j
    Next i
    Set c = Range("M2:M8").Find(Target, , , 1)   '找科目
    Set d = Range("M2:S2").Find(Cells(2, Target.Column), , , 1)    '找年级
    If Not c Is Nothing And Not d Is Nothing Then Target = Target & ct(c.Row - 2, d.Column - 13)   '匹配科目+教师
End If
End Sub

564511498

如果改成现在的附件的样子星期二的又该如何查找，还有就是选中几个单元格进行内容清除时出错，又如何修改。

mineshine

Private Sub Worksheet_Change(ByVal Target As Range)
Dim ct(6, 6)
Dim i As Integer
Dim c, d As Range
If Target.Row > 2 And Target.Row < 10 And Target.Column > 1 And Target.Column < 16 Then
    For i = 1 To 6
        For j = 1 To 6
            ct(i, j) = Cells(i + 2, j + 16)
            'Debug.Print "ct(" & i & "," & j & ")=cells(" & i + 2 & "," & j + 16 & ")=" & Cells(i + 2, j + 16)
        Next j
    Next i
    Set c = Range("P2:P8").Find(Target, , , 1)
    Set d = Range("P2:V2").Find(Cells(2, Target.Column), , , 1)
    If Not c Is Nothing And Not d Is Nothing Then Target = Target & ct(c.Row - 2, d.Column - 16)
End If
End Sub

564511498