如何建立一个下来菜单

wcz55 · 发表于 2022-12-4 23:32

我用数据透视表建立了一个库存表，请教如何实现以下想法？
1、根据B列(B11)的内容选择《库存表》物料代码 (列）对应的物料编码在G列（G11）单元格内出现一个下拉菜单，
2、在K列（K11）《本批库存》的单元格内显示该物料编码的库存数
谢谢

wcz55 · 发表于 2022-12-5 08:41

本帖最后由 wcz55 于 2022-12-5 08:42 编辑

我用公式和有效性做了一个，计算太慢了。哪位大神能给优化一下

3190496160 · 发表于 2022-12-5 10:14

Private Sub Worksheet_Change(ByVal T As Range)
If T.Row > 10 And T.Column = 2 Then
If T.Count > 1 Then End
If T.Value = "" Then End
Dim ar As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("库存表")
      r = .Cells(Rows.Count, 2).End(xlUp).Row
      ar = .Range("b4:c" & r)
End With
For i = 2 To UBound(ar)
      If Trim(ar(i, 1)) = Trim(T.Value) Then
         d(Trim(ar(i, 2))) = ""
      End If
Next i
T.Offset(, 4).Select ''
With Selection.Validation
      .Delete '清除原来的有效性
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(d.keys, ",") ''用字典d3关键字建立有效性
End With ''
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal T As Range)
If T.Row > 10 And T.Column = 2 Then
If T.Count > 1 Then End
Dim ar As Variant
Dim d As Object
Set d = CreateObject("scripting.dictionary")
With Sheets("库存表")
      r = .Cells(Rows.Count, 2).End(xlUp).Row
      ar = .Range("b4:b" & r)
End With
For i = 2 To UBound(ar)
      If Len(Trim(ar(i, 1))) = 5 Then
         d(Trim(ar(i, 1))) = ""
      End If
Next i
T.Select ''
With Selection.Validation
      .Delete '清除原来的有效性
      .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(d.keys, ",") ''用字典d3关键字建立有效性
End With ''
End If
End Sub

3190496160 · 发表于 2022-12-5 10:15

库存表2022求助.rar (48.6 KB, 下载次数: 14)

3190496160 · 发表于 2022-12-5 10:16

要做一个像样点的进销存，就不要使用那么多的公式，公式太多，文件反应速度就会很慢，甚至卡死

wcz55 · 发表于 2022-12-5 15:36

3190496160 发表于 2022-12-5 10:14
Private Sub Worksheet_Change(ByVal T As Range)
If T.Row > 10 And T.Column = 2 Then
If T.Count ...

谢谢老大

wcz55 · 发表于 2022-12-5 16:05

老大你好，能把下面的代码放到最前面吗？物料代码自动填充，不要选择下拉，防止出错，谢谢，不胜感激

Dim c As Range, rng
If t.Address = "$B$5" Then
[a11:d26] = ""
[F11:H26] = ""
With Sheets("产品配方")
      Set c = .Cells.Find(t.Value, , , , , 1)
      If Not c Is Nothing Then
         rng = .Range(.Cells(c.Row + 0, 3), .Cells(c.End(4).Row, 6))
         [A11].Resize(UBound(rng), 4) = rng
      End If
End With

Else
Exit Sub
End If

wcz55 · 发表于 2022-12-5 16:26

1、能否在单元格B5发生变化时，A11:D26根据产品配方自动填入相应内容，物料编码根据物料代码生成下拉，谢谢
2、物料代码的数据有效性下拉去掉，谢谢

余茂贤 · 发表于 2022-12-6 10:47

学习了，
https://club.excelhome.net/thread-1648440-1-1.html 哪个大神帮我搞定一下

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

[求助] 如何建立一个下来菜单

评分