根据月份自动更新 查找符合条件的值

闲闲zzm

BOOK.zip (9.79 KB, 下载次数: 11)

2023-12-29 18:20 上传

点击文件名下载附件

数据源：sheet2中提取当前月份的成绩 到sheet1表中（自动更新）

蓝桥玄霜

成绩的例子：

闲闲zzm

蓝桥玄霜 发表于 2023-12-29 19:24
成绩的例子：

老师 附件，我需要F8

gwjkkkkk

请参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()   '//2023.12.29
   
2.     Dim arr
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     rq = Format(Date, "yyyy年mm月")
   
5.     With Sheets("Sheet2")
   
6.         r = .Cells(Rows.Count, 3).End(3).Row
   
7.         arr = .Range("c2:h" & r)
   
8.     End With
   
9.     For i = 2 To UBound(arr)
   
10.         yf = Format(arr(i, 3), "yyyy年mm月")
    
11.         s = yf & arr(i, 1)
    
12.         If yf = rq Then
    
13.             If Not d.exists(s) Then
    
14.                 d(s) = Array(arr(i, 4), arr(i, 5), arr(i, 6))
    
15.             End If
    
16.         End If
    
17.     Next
    
18.     With Sheets("Sheet1")
    
19.         r = .Cells(Rows.Count, 2).End(3).Row
    
20.         .Range("d3:f" & r) = ""
    
21.         arr = .Range("b2:f" & r)
    
22.         For i = 2 To UBound(arr)
    
23.             s = rq & arr(i, 1)
    
24.             If d.exists(s) Then
    
25.                 For j = 3 To UBound(arr, 2)
    
26.                     arr(i, j) = d(s)(j - 3)
    
27.                 Next
    
28.             End If
    
29.         Next
    
30.         .Range("b2:f" & r) = arr
    
31.     End With
    
32.     Set d = Nothing
    
33.     MsgBox "OK！"
    
34. End Sub

复制代码

ykcbf1100

附件供参考。。。

leeson7502

你这个sheet1中的ID对应的姓名，有几个与sheet2中的不一样

章州

然后在工作簿事件中，启用open事件，调用该过程，后续过了下个月也会自动更新

章州