Excel精英培训网

 找回密码
 注册

QQ登录

只需一步,快速开始

你正在寻找更好的Excel学习教程吗?Excel技巧80集+数据透视表+函数初中高全套+VBA80集,想学的这儿全都有
查看: 150|回复: 1

[求助] 求元老们做个模糊查询与筛选的代码

[复制链接]
发表于 2019-7-21 19:47 | 显示全部楼层 |阅读模式
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
先谢谢各位元老了

模糊筛选制作.zip

34.84 KB, 下载次数: 11

 楼主| 发表于 2019-7-22 21:34 | 显示全部楼层
以下的这些代码都是从这个网站找到的,感觉很好,但我不会运用与更改,懂代码的高人,帮个忙把这些代码做到“模糊筛选制作”内,在下感谢了。
Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, _
        ByVal lpWindowName As String) As Long
Private Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" (ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function MoveWindow Lib "user32.dll" (ByVal hwnd As Long, ByVal x As Long, _
        ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
        
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    On Error Resume Next
    If Target.Count > 1 Then Exit Sub
    If Target.Column <> 8 Then Exit Sub     
    Dim lHwnd As Long
    Dim lDC As Long
    Dim lCaps As Long
    Dim lngLeft As Long
    Dim lngTop As Long
    Dim sngPiexlToPiont As Single
    Const lLogPixelsX = 88
    lDC = GetDC(0)
    lCaps = GetDeviceCaps(lDC, lLogPixelsX)
    sngPiexlToPiont = 72 / lCaps * (100 / ActiveWindow.Zoom)
    lngLeft = CLng(ActiveWindow.PointsToScreenPixelsX(0) + (Target.Offset(1, 1).Left / sngPiexlToPiont))     '
    lngTop = CLng(ActiveWindow.PointsToScreenPixelsY(0) + (Target.Offset(1, 1).Top / sngPiexlToPiont))       '
    UserForm1.StartUpPosition = 0
    lHwnd = FindWindow(vbNullString, UserForm1.Caption)
    MoveWindow lHwnd, lngLeft, lngTop, 360, 360, True
    UserForm1.Show
    End Sub




Private Sub ListBox1_Click()
    ActiveCell.Value = ListBox1.Value
   Me.ListBox1.Visible = False
    Unload Me
End Sub

Private Sub TextBox1_Change()
arr = Sheet3.[a1].CurrentRegion
ReDim brr(1 To UBound(arr), 1 To 1)
For i = 1 To UBound(arr)
If InStr(arr(i, 1), TextBox1.Text) > 0 Then
n = n + 1
brr(n, 1) = arr(i, 1)
End If
Next i
ListBox1.List = brr
End Sub

Private Sub UserForm_Initialize()
' ListBox1.List = Range("sheet3!a1:a" & Worksheets("sheet3").Cells(Worksheets("sheet3").Rows.Count, 1).End(3).Row).Value
End Sub
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2019-8-19 01:46 , Processed in 0.046800 second(s), 5 queries , Gzip On, Redis On.

Powered by Discuz! X3.4

© 2001-2017 Comsenz Inc.

快速回复 返回顶部 返回列表