求一段VBA，将与朱倩同学各科成绩差符合要求的学生找出并填入结果显示区内

zhengsong347

用VBA：将与朱倩同学各科成绩差符合要求的学生找出并填入结果显示区内

鄂龙蒙

楼主设定的条件：是各科及总分的相差是全部符合？还是单个符合？结果不一样的呀！

zhengsong347

鄂龙蒙 发表于 2023-5-7 16:05
楼主设定的条件：是各科及总分的相差是全部符合？还是单个符合？结果不一样的呀！

要求各科全部符合，，，，至少总分符合

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     With Worksheets("初一分班原始成绩")
   
5.         tj = .Range("f2:o4")
   
6.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
7.         arr = .Range("a7:j" & r)
   
8.         ReDim brr(1 To UBound(arr), 1 To UBound(arr, 2))
   
9.         m = 0
   
10.         For i = 1 To UBound(arr)
    
11.             If arr(i, 4) <> tj(1, 4) Then
    
12.                 For j = 6 To UBound(arr, 2)
    
13.                     If Abs(arr(i, j) - tj(1, j)) > tj(3, j) Then
    
14.                         Exit For
    
15.                     End If
    
16.                 Next
    
17.                 If j > UBound(arr, 2) Then
    
18.                     m = m + 1
    
19.                     For j = 1 To UBound(arr, 2)
    
20.                         brr(m, j) = arr(i, j)
    
21.                     Next
    
22.                 End If
    
23.             End If
    
24.         Next
    
25.         If m = 0 Then
    
26.             MsgBox "没有符合条件数据！"
    
27.             Exit Sub
    
28.         End If
    
29.         .Range("r4:aa" & .Rows.Count).ClearContents
    
30.         .Range("r4").Resize(m, UBound(brr, 2)) = brr
    
31.         MsgBox "共查到" & m & "条符合条件数据！"
    
32.     End With
    
33.         
    
34. End Sub
    

复制代码

chxw68

详见附件。