模糊查询 并显示结果

wang-way

38180203 发表于 2024-6-4 08:25
老师,输入发货数量查询时出现这样的.

我这里没有问题的

3190496160

Sub 多条件查询()
Application.ScreenUpdating = False
Dim ar As Variant, rr_1 As Variant, rr_2 As Variant
Dim i As Long, r As Long, rs As Long
Dim brr_1(), brr_2(), ar_1(), ar_2()
With Sheets("查询")
    .UsedRange.Offset(4) = Empty
    rr_1 = .Range("a2:k2")
    rr_2 = .Range("l2:v2")
    ReDim ar_1(1 To UBound(rr_1, 2), 1 To 2)
    ReDim ar_2(1 To UBound(rr_2, 2), 1 To 2)
    For j = 1 To UBound(rr_1, 2)
        If rr_1(1, j) <> "" Then
            n_1 = n_1 + 1
            ar_1(n_1, 1) = rr_1(1, j)
            ar_1(n_1, 2) = j
        End If
    Next j
    For j = 1 To UBound(rr_2, 2)
        If rr_2(1, j) <> "" Then
            n_2 = n_2 + 1
            ar_2(n_2, 1) = rr_2(1, j)
            ar_2(n_2, 2) = j
        End If
    Next j
    If n_1 = "" And n_2 = "" Then MsgBox "至少输入一个查询条件！": End
    If n_1 <> "" Then
        With Sheets("数据库1")
             r = .Cells(Rows.Count, 1).End(xlUp).Row
             ar = .Range("a2:k" & r)
        End With
        ReDim brr_1(1 To UBound(ar), 1 To UBound(ar, 2))
        For i = 2 To UBound(ar)
            sl = 0
            For s = 1 To n_1
                zd = VBA.UCase(ar_1(s, 1))
                lh = ar_1(s, 2)
                If lh = 1 Then
                    yf = Month(ar(i, lh))
                    If Val(yf) = zd Then
                        sl = sl + 1
                    End If
                Else
                    If InStr(VBA.UCase(ar(i, lh)), zd) > 0 Then
                        sl = sl + 1
                    End If
                End If
            Next s
            If sl = n_1 Then
                m_1 = m_1 + 1
                For j = 1 To UBound(ar, 2)
                    brr_1(m_1, j) = ar(i, j)
                Next j
            End If
        Next i
        If m_1 = "" Then MsgBox "数据库1没有符合条件的数据！": End
        .[a5].Resize(m_1, UBound(brr_1, 2)) = brr_1
    End If

    If n_2 <> "" Then
        With Sheets("数据库2")
             r = .Cells(Rows.Count, 1).End(xlUp).Row
             ar = .Range("a2:k" & r)
        End With
        ReDim brr_2(1 To UBound(ar), 1 To UBound(ar, 2))
        For i = 2 To UBound(ar)
            sl = 0
            For s = 1 To n_2
                zd = VBA.UCase(ar_2(s, 1))
                lh = ar_2(s, 2)
                If lh = 1 Then
                    yf = Month(ar(i, lh))
                    If Val(yf) = zd Then
                        sl = sl + 1
                    End If
                Else
                    If InStr(VBA.UCase(ar(i, lh)), zd) > 0 Then
                        sl = sl + 1
                    End If
                End If
            Next s
            If sl = n_2 Then
                m_2 = m_2 + 1
                For j = 1 To UBound(ar, 2)
                    brr_2(m_2, j) = ar(i, j)
                Next j
            End If
        Next i
        If m_2 = "" Then MsgBox "数据库2没有符合条件的数据！": End
        .[l5].Resize(m_2, UBound(brr_2, 2)) = brr_2
    End If
End With
Application.ScreenUpdating = True
MsgBox "ok!"
End Sub

3190496160

CX.rar (38.27 KB, 下载次数: 33)

2024-6-4 09:33 上传

点击文件名下载附件

3190496160

vba代码完成的，仅供参考

38180203

3190496160 发表于 2024-6-4 09:32
Sub 多条件查询()
Application.ScreenUpdating = False
Dim ar As Variant, rr_1 As Variant, rr_2 As Va ...

大师就是大师,,,都不用修改. 做出来的东西完全符合我的要求. 细节很到位..谢谢

38180203

3190496160 发表于 2024-6-4 09:34
vba代码完成的，仅供参考

老师您好,,发现一个小问题,:  就是只要左边没有的  右边有的也不会显示出来.  

反观  如果左边有的,,右边没有  这样左边可以显示  这是正常的.

38180203

3190496160 发表于 2024-6-4 09:34
vba代码完成的，仅供参考

右边搜索的关键词没变  左边有,,右边才会显示...麻烦老大  谢谢你

3190496160

38180203 发表于 2024-6-4 16:32
右边搜索的关键词没变  左边有,,右边才会显示...麻烦老大  谢谢你

先学会送花再说吧

38180203

3190496160 发表于 2024-6-4 20:58
先学会送花再说吧

好吧，我懂了

wang-way

38180203 发表于 2024-6-4 21:15
好吧，我懂了

你的意思是我写的就要你修改？