请大师编写一段代码，谢谢

jwjnh001

要求很简单，就是把第二张中的新班级替换到第一张表对应姓名下的班级。请见附件。

jwjnh001

其他人员的班级不变。

3190496160

Sub 调整班级()
Set d = CreateObject("scripting.dictionary")
With Sheets("班级调整表")
    Ws = .Cells(Rows.Count, 2).End(xlUp).Row
    br = .Range("b1:f" & Ws)
End With
With Sheets("列表")
    Ws = .Cells(Rows.Count, 1).End(xlUp).Row
    ar = .Range("a1:d" & Ws)
    For i = 2 To UBound(ar)
        If Trim(ar(i, 1)) <> "" And Trim(ar(i, 4)) <> "" Then
            s = Trim(ar(i, 1)) & "|" & Trim(ar(i, 4))
            d(s) = i
        End If
    Next i
    For i = 2 To UBound(br)
        ss = Trim(br(i, 1)) & "|" & Trim(br(i, 4))
        m = d(ss)
        If m <> "" Then
            ar(m, 4) = br(i, 5)
        End If
    Next i
     .Range("a1:d" & Ws) = ar
End With
End Sub

3190496160

教育信息.zip (14.34 KB, 下载次数: 5)

2020-1-30 11:48 上传

点击文件名下载附件

jwjnh001

唉，就是数组和字典学不会，看得不难，就是记不住。

lyt1979

Option Explicit

Sub 调整班级()
   
    Dim i, k As Integer
    Dim ws, bjtzb As Worksheet
    Dim name
   
    Set ws = Worksheets("列表")
    Set bjtzb = Worksheets("班级调整表")
   
    For i = 2 To 16   '第一个循环从第二行起往下查询列表
        name = ws.Cells(i, 1)
        
        k = 2      '第二个循环也是从第二行开始查班级调整表
        
        Do While bjtzb.Cells(k, 2) <> ""
        
            If bjtzb.Cells(k, 2) = name Then
                ws.Cells(i, 4) = bjtzb.Cells(k, 6)
            End If
            
            k = k + 1
            
        Loop
    Next i
   
   
   
   
   
End Sub