改成模糊查询

ddz79101

老师！有代码《系查询。如何修改为模糊查询
Option Explicit
Sub 查询()
    Dim ar, br, i&, j&, r&, N&, dic As Object, strInput$, iPosCol&, wks As Worksheet
    Sheets("查询").Select
    Application.ScreenUpdating = False
    strInput = InputBox("请输入关键字：", "名称")
    If strInput = "" Then Exit Sub
    Set dic = CreateObject("Scripting.Dictionary")
   
    With [a4].CurrentRegion
        .Offset(1).Clear
        ar = .Resize(12 ^ 3)
        For i = 1 To UBound(ar, 2): dic(ar(1, i)) = i: Next
        r = 1
    End With
    For Each wks In Sheets
        If wks.Name <> ActiveSheet.Name Then
            With wks
                br = .[a1].CurrentRegion
                For i = 2 To UBound(br)
                    N = 0
                    For j = 1 To UBound(br, 2)
                        If br(i, j) = strInput Then
                             N = i: Exit For
                        End If
                    Next j
                    If N <> 0 Then
                        r = r + 1
                        For j = 1 To UBound(br, 2)
                            If dic.exists(br(1, j)) Then
                                iPosCol = dic(br(1, j))
                                ar(r, iPosCol) = br(i, j)
                            End If
                        Next j
                        ar(r, UBound(ar, 2)) = .Name
                    End If
                Next i
            End With
        End If
    Next wks
   
    With [a4].Resize(r, UBound(ar, 2))
        .Columns(1).NumberFormatLocal = "0000"
        .Columns(2).NumberFormatLocal = "yyyy-mm-dd"
        .Columns(5).NumberFormatLocal = "@"
        .Columns("F:h").NumberFormatLocal = "0.00"
        .Value = ar
        .HorizontalAlignment = xlCenter
        .Borders.LineStyle = xlContinuous
        .Font.Size = 10
    End With
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub
请老师指教。谢谢

shiruiqiang

    If instr(br(i, j), strInput) Then
       N = i: Exit For
   End If

ykcbf1100

源代码是gwjkkkkk老师写的吧，让他来吧。

ddz79101

shiruiqiang 发表于 2025-1-27 15:57
If instr(br(i, j), strInput) Then
       N = i: Exit For
   End If

老师！是加这里吗
strInput = InputBox("&#199;&#235;ê&#228;è&#235;1&#216;&#188;ü×&#214;￡o", "&#195;&#251;3&#198;")
    ‘’'If strInput = "" Then Exit Sub
    If InStr(br(i, j), strInput) Then
       N = i: Exit For
    End If
    Set dic = CreateObject("Scripting.Dictionary")

ddz79101

shiruiqiang 发表于 2025-1-27 15:57
If instr(br(i, j), strInput) Then
       N = i: Exit For
   End If

老师！运行不行也

quqiyuan

Option Explicit
Sub 查询()
    Dim ar, br, i&, j&, r&, N&, dic As Object, strInput$, iPosCol&, wks As Worksheet
    Sheets("查询").Select
    Application.ScreenUpdating = False
    strInput = InputBox("请输入关键字：", "名称")
    If strInput = "" Then Exit Sub
    Set dic = CreateObject("Scripting.Dictionary")
   
    With [a4].CurrentRegion
        .Offset(1).Clear
        ar = .Resize(12 ^ 3)
        For i = 1 To UBound(ar, 2): dic(ar(1, i)) = i: Next
        r = 1
    End With
    For Each wks In Sheets
        If wks.Name <> ActiveSheet.Name Then
            With wks
                br = .[a1].CurrentRegion
                For i = 2 To UBound(br)
                    N = 0
                    For j = 1 To UBound(br, 2)
                        If Instr(br(i, j), strInput) Then
                             N = i: Exit For
                        End If
                    Next j
                    If N <> 0 Then
                        r = r + 1
                        For j = 1 To UBound(br, 2)
                            If dic.exists(br(1, j)) Then
                                iPosCol = dic(br(1, j))
                                ar(r, iPosCol) = br(i, j)
                            End If
                        Next j
                        ar(r, UBound(ar, 2)) = .Name
                    End If
                Next i
            End With
        End If
    Next wks
   
    With [a4].Resize(r, UBound(ar, 2))
        .Columns(1).NumberFormatLocal = "0000"
        .Columns(2).NumberFormatLocal = "yyyy-mm-dd"
        .Columns(5).NumberFormatLocal = "@"
        .Columns("F:h").NumberFormatLocal = "0.00"
        .Value = ar
        .HorizontalAlignment = xlCenter
        .Borders.LineStyle = xlContinuous
        .Font.Size = 10
    End With
    Set dic = Nothing
    Application.ScreenUpdating = True
    Beep
End Sub

ykcbf1100

ddz79101 发表于 2025-1-27 16:31
老师！运行不行也

最好上传附件。没附件不方便测试。

ddz79101

ykcbf1100 发表于 2025-1-27 16:30
源代码是gwjkkkkk老师写的吧，让他来吧。

老师！不知道也！是谁写的，没有查到

shiruiqiang

ddz79101 发表于 2025-1-27 16:31
老师！运行不行也

gwjkkkkk

ykcbf1100 发表于 2025-1-27 16:30
源代码是gwjkkkkk老师写的吧，让他来吧。

看来每个人写代码的风格也比较固定，好像是我写的，但还是建议楼主上传附件便于其他老师发挥自己的水平。