根据学生的语种，剔除不是他的语种成绩

戎马书生222

在工作表“学生信息”中，每个学生都有自己的语种信息，

如何在工作表“成绩处理”中，根据考号，获得自己的“语种”，假设考号 的语种是英语，就把日语和西语的成绩，变为空。

蓝桥玄霜

语种的例子：

wang-way

你不是问了好几个这样的问题吗   修改一下代码啦

limonet

关键字：left join iif

limonet

Sub limonet()
    Dim Cn As Object, StrSQL$
    Set Cn = CreateObject("Adodb.Connection")
    Cn.Open "Provider=Microsoft.ACE.OLEDB.12.0;Extended Properties=Excel 12.0;Data Source=" & ThisWorkbook.FullName
    StrSQL = "Select a.考号,英语,日语,西语,b.语种 From [成绩处理$B:H]a left join [学生信息$A:F]b On a.考号=b.考号"
    StrSQL = "Select 考号,iif(英语>0 and 语种='英',Null,日语),iif(英语>0 and 语种='英',Null,西语) From (" & StrSQL & ")"
    Range("M2").CopyFromRecordset Cn.Execute(StrSQL)
End Sub

usedrange

1. Sub t()
   
2.     Dim u, m%, i%, arr, dic, k
   
3.     Set dic = CreateObject("scripting.dictionary")
   
4.     With Sheet1
   
5.         m = .[a1].End(4).Row
   
6.         arr = .Range("a2:e" & m)
   
7.         For i = 1 To UBound(arr)
   
8.             dic(arr(i, 1)) = arr(i, 5)
   
9.         Next i
   
10.     End With
    
11.     With Sheets("成绩处理")
    
12.         m = .[a2].End(4).Row
    
13.         For i = 2 To m
    
14.             If dic.exists(.Cells(i, "b").Value) Then
    
15.                 k = dic(.Cells(i, 2).Value)
    
16.                 If k = "英" Then
    
17.                     .Range("g" & i & ":" & "h" & i).ClearContents
    
18.                 ElseIf k = "日" Then
    
19.                     Union(.Range("f" & i), .Range("h" & i)).ClearContents
    
20.                 Else
    
21.                     .Range("f" & i & ":" & "g" & i).ClearContents
    
22.                 End If
    
23.             End If
    
24.         Next i
    
25.     End With
    
26.     Set dic = Nothing
    
27. End Sub

复制代码

戎马书生222

Sub test2()
Dim i&, j&, k&, arr, brr, yz
arr = Sheets("成绩处理").Range("a1").CurrentRegion
brr = Sheets("学生信息").Range("a1").CurrentRegion
Set d = CreateObject("scripting.dictionary")
Sheets("学生信息").Activate

For i = 2 To UBound(brr)
    If Not d.exists(brr(i, 1)) Then
    d(brr(i, 1)) = brr(i, 5)
    End If
Next
Sheets("成绩处理").Activate
For j = 2 To UBound(arr)
    yz = d(arr(j, 2))
        Select Case yz
        Case "英"
            arr(j, 7) = "0"
            arr(j, 8) = "0"
        Case "日"
            arr(j, 6) = ""
            arr(j, 8) = ""
        Case "西"
            arr(j, 6) = ""
            arr(j, 7) = ""
    End Select
   
Next j
End Sub

看上去没毛病，咋就是不剔除自己语种以外的成绩？

gwjkkkkk

Option Explicit
Sub TEST6()
    Dim ar, i&, j&, r&, dic As Object
   
    Application.ScreenUpdating = False
    Set dic = CreateObject("Scripting.Dictionary")
    ar = Worksheets(2).[A1].CurrentRegion.Value
    For i = 2 To UBound(ar)
        dic(ar(i, 1)) = ar(i, 5)
    Next i
   
    r = Cells(Rows.Count, "A").End(xlUp).Row
    ar = Range("A1:H" & r).Value
    For i = 2 To UBound(ar)
        If dic.exists(ar(i, 2)) Then
            For j = 6 To 8
                If ar(i, 8) Then
                    If Mid(ar(1, j), 1, 1) <> dic(ar(i, 2)) Then ar(i, j) = Empty
                End If
            Next j
        End If
    Next i
   
    [A1].Resize(UBound(ar), UBound(ar, 2)) = ar
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

gwjkkkkk

...............

zhangcheng6688

gwjkkkkk 发表于 2024-6-20 19:20
Option Explicit
Sub TEST6()
    Dim ar, i&, j&, r&, dic As Object

向老师学习代码，If ar(i, 8) Then这个条件不理解，望解答