根据教师任课班级与科目匹配教师姓名

lcmphy

请高手用VBA代码，根据教师任课班级与科目匹配每位学生的任课教师姓名,教师任教班级与科目在js工作表，学生成绩与教师匹配科目在sheet1工作表。实际班级与人数较多，压缩文件只是样表。

cnmlgb9998

你要达到一个什么效果，把效果图，展示 一下。

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2024.9.20
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     arr = Sheets("js").UsedRange
   
5.     For i = 2 To UBound(arr)
   
6.         For j = 2 To UBound(arr, 2)
   
7.             If arr(i, j) <> Empty Then
   
8.                 s = arr(i, 1) & "|" & arr(1, j)
   
9.                 d(s) = arr(i, j)
   
10.             End If
    
11.         Next
    
12.     Next
    
13.     With Sheets("Sheet1")
    
14.         arr = .UsedRange
    
15.         For i = 2 To UBound(arr)
    
16.             For j = 22 To UBound(arr, 2)
    
17.                 s = arr(i, 3) & "|" & arr(1, j)
    
18.                 If d.exists(s) Then
    
19.                     arr(i, j) = d(s)
    
20.                 Else
    
21.                     arr(i, j) = ""
    
22.                 End If
    
23.             Next
    
24.         Next
    
25.         .UsedRange = arr
    
26.     End With
    
27.     Set d = Nothing
    
28.     Application.ScreenUpdating = True
    
29.     MsgBox "OK！"
    
30. End Sub
    
31. 
    

复制代码

lcmphy

cnmlgb9998 发表于 2024-9-20 18:32
你要达到一个什么效果，把效果图，展示 一下。

sheet1工作表红色字体内容根据js工作表教师任教班级与科目，用VBA代码填写

quqiyuan

参与一下，仅供参考。。。

quqiyuan

代码如下。。。
Sub test()
    Set wb = ThisWorkbook
    Set sh = wb.Sheets("Sheet1")
    Set sht = wb.Sheets("js")
    Set d = CreateObject("scripting.dictionary")
    arr = sht.UsedRange
    For i = 2 To UBound(arr)
        s = arr(i, 1)
        d(s) = i
    Next
    For i = 2 To UBound(arr, 2)
        s = arr(1, i)
        d(s) = i
    Next
    Set Rng = sh.UsedRange
    brr = Rng
    For i = 2 To UBound(brr)
        For j = 22 To UBound(brr, 2)
            brr(i, j) = arr(d(brr(i, 3)), d(brr(1, j)))
        Next
    Next
    sh.UsedRange = brr
    Beep
End Sub

lcmphy

ykcbf1100 发表于 2024-9-20 18:39
附件供参考。。。

谢谢ykcbf1100的帮助！

lcmphy

quqiyuan 发表于 2024-9-20 18:45
参与一下，仅供参考。。。

谢谢quqiyuan的帮助！

lcmphy

cnmlgb9998 发表于 2024-9-20 18:32
你要达到一个什么效果，把效果图，展示 一下。

谢谢cnmlgb9998的提醒，论坛高手如云，难的不是写代码，难的是求助的如何把问题表述清楚。