自定义查找函数

绝峰 · 发表于 2025-3-21 18:22

请各位大侠帮忙设置一个自定义函数，具体要求见附件，谢谢！

hwf0101 · 发表于 2025-3-21 19:55

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row <> 3 And (Target.Column <> 5 Or Target.Column <> 3) Then Exit Sub
' 检查变动的单元格是否为 C3
If Not Intersect(Target, Range("C3")) Is Nothing Then
' 检查 E3 是否为合并单元格
If Range("E3").MergeCells Then
' 清空合并单元格的内容
Range("E3").MergeArea.ClearContents
Else
' 如果不是合并单元格，直接清空 E3 内容
Range("E3").ClearContents
End If
End If
Dim Dic, cell As Range
Dim i As Integer
On Error Resume Next
Set Dic = CreateObject("Scripting.Dictionary")
Select Case Target(1).Column
Case 5
For Each cell In ThisWorkbook.Sheets("产品型号").Range("C4").Resize(ThisWorkbook.Sheets("产品型号").UsedRange.Rows.Count - 2, 1)
If cell = Target(1).Offset(0, -2) Then
Dic(cell.Offset(0, 1).Text) = ""
End If
Next cell
With Target(1).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=Join(Dic.Keys, ",")
.InCellDropdown = True
End With
End Select
Dic.RemoveAll
End Sub

复制代码

sunya_0529 · 发表于 2025-3-21 19:58

你要的东西应该叫“级联菜单”吧？用WPS里的JSA演示一下——

hwf0101 · 发表于 2025-3-21 19:58

本帖最后由 hwf0101 于 2025-3-21 20:09 编辑

详细见附件：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Row <> 3 And (Target.Column <> 5 Or Target.Column <> 3) Then Exit Sub
' 检查变动的单元格是否为 C3
If Not Intersect(Target, Range("C3")) Is Nothing Then
' 检查 E3 是否为合并单元格
If Range("E3").MergeCells Then
' 清空合并单元格的内容
Range("E3").MergeArea.ClearContents
Else
' 如果不是合并单元格，直接清空 E3 内容
Range("E3").ClearContents
End If
End If
Dim Dic, cell As Range
Dim i As Integer
On Error Resume Next
Set Dic = CreateObject("Scripting.Dictionary")
Select Case Target(1).Column
Case 5
For Each cell In ThisWorkbook.Sheets("产品型号").Range("C4").Resize(ThisWorkbook.Sheets("产品型号").UsedRange.Rows.Count - 2, 1)
If cell = Target(1).Offset(0, -2) Then
Dic(cell.Offset(0, 1).Text) = ""
End If
Next cell
With Target(1).Validation
.Delete
.Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Formula1:=Join(Dic.Keys, ",")
.InCellDropdown = True
End With
End Select
Dic.RemoveAll
End Sub

复制代码

绝峰 · 发表于 2025-3-21 22:39

谢谢大家，不用VB，用函数可以实现吗？

hwf0101 · 发表于 2025-3-22 07:21

绝峰发表于 2025-3-21 22:39
谢谢大家，不用VB，用函数可以实现吗？

个性化的东东，编程最简单好用，

温馨云 · 发表于 2025-3-22 13:06

联级菜单，请参考这个贴子，一级、二级、三级联动都可作。
【Excel操作技巧】Excel创建一级、二级、三级……联动下拉菜单，一次讲透它！

温馨云 · 发表于 2025-3-22 13:45

请参考

联动菜单函数.zip (14 KB, 下载次数: 12)

温馨云 · 发表于 2025-3-22 14:26

本帖最后由温馨云于 2025-3-22 14:27 编辑

这个是根据usedrange老师的作品作的，更好用，VBA的，用起来得心应手。

联动菜单函数.zip (22.2 KB, 下载次数: 24)

绝峰 · 发表于 2025-3-24 20:33

温馨云发表于 2025-3-22 14:26
这个是根据usedrange老师的作品作的，更好用，VBA的，用起来得心应手。

谢谢！如果有的产品没有规格，它就会出错了，实事确实是有产品规格为空的，请问这个怎么解决？

用户名		自动登录	找回密码
密码			免费注册

[求助] 自定义查找函数