如何建立一个下来菜单

wcz55

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

wcz55

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

3190496160

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求助.rar (48.6 KB, 下载次数: 14)

2022-12-5 10:15 上传

点击文件名下载附件

3190496160

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

wcz55

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

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

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

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

余茂贤

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