|
|
楼主 |
发表于 2019-7-22 21:30
|
显示全部楼层
[广告] Excel易用宝 - 提升Excel的操作效率 · Excel / WPS表格插件 ★ 免费下载 ★ ★ 使用帮助★
以下的这些代码都是从这个网站找到的，感觉很好，但我不会运用与更改，懂代码的高人，帮个忙把这些代码做到“模糊筛选制作”内，在下感谢了。
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 |
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2019-7-21 19:43
