双条件查询双结果

usedrange

不知道这个是不是猜对了

usedrange

1. Sub tt()
   
2.     Dim ar, br, cr, i%, j%
   
3.     ar = Sheets("系统").[a1].CurrentRegion
   
4.     br = Sheets("地区").[a1].CurrentRegion
   
5.     With Sheets("报名")
   
6.         cr = .[a1].CurrentRegion
   
7.         .[c:c].NumberFormat = "@"
   
8.         For i = 2 To UBound(cr)
   
9.             For j = 6 To 9
   
10.                 cr(i, j) = "查无"
    
11.             Next j
    
12.             For j = 2 To UBound(ar)
    
13.                 If cr(i, 3) = ar(j, 2) Then
    
14.                     cr(i, 6) = ar(j, 3)
    
15.                     cr(i, 7) = ar(j, 4)
    
16.                     Exit For
    
17.                 End If
    
18.             Next j
    
19.             For j = 2 To UBound(br)
    
20.                 If cr(i, 4) = br(j, 1) And Int(cr(i, 5)) = Int(br(j, 2)) Then
    
21.                     cr(i, 8) = br(j, 3)
    
22.                     cr(i, 9) = br(j, 4)
    
23.                     Exit For
    
24.                 End If
    
25.             Next j
    
26.         Next i
    
27.         .[a1].Resize(UBound(cr), UBound(cr, 2)) = cr
    
28.     End With
    
29. End Sub

复制代码

2324

非常感谢各位的热心回复，真是帮了大帮！

chenyun1234

chxw68 发表于 2024-8-20 16:25
详见附件。

在很多帖子中，都能看到老师的出手，给老师

Qs18

Sub qs()
    Dim arr, i, j, dic
    Set dic = CreateObject("scripting.dictionary")
    arr = Sheet2.Range("a1").CurrentRegion.Value
    For i = 2 To UBound(arr)
        s = arr(i, 1) & "|" & arr(i, 2)
        dic(s) = Array(arr(i, 3), arr(i, 4))
        
    Next
    brr = Sheet1.Range("a1").CurrentRegion.Value
    For i = 2 To UBound(brr)
        s = brr(i, 2) & "|" & brr(i, 3)
        If dic.exists(s) Then
            t = dic(s)
            brr(i, 6) = t(0): brr(i, 7) = t(1)
        Else
            brr(i, 6) = "查无": brr(i, 7) = "查无"
        End If
    Next
    dic.RemoveAll
    crr = Sheet3.Range("a1").CurrentRegion.Value
    For i = 2 To UBound(crr)
        s = crr(i, 1) & "|" & crr(i, 2)
        dic(s) = Array(crr(i, 3), crr(i, 4))
    Next
    For i = 2 To UBound(brr)
        If brr(i, 6) = "查无" Then
            brr(i, 8) = "查无": brr(i, 9) = "查无"
        Else
            s = brr(i, 4) & "|" & brr(i, 5)
            If dic.exists(s) Then
                t = dic(s)
                brr(i, 8) = t(0): brr(i, 9) = t(1)
            Else
                brr(i, 8) = "查无": brr(i, 9) = "查无"
            End If
        End If
    Next
    For cl = 6 To 9
        Sheet1.Cells(1, cl).Resize(UBound(brr), 1) = Application.Index(brr, 0, cl)
    Next
    Set dic = Nothing
End Sub

Qs18

试试...........

Qs18

试试...........