代码问题

深秋红叶2019

物品出入库存表代码出错，然后本期学员名单下拉菜单仅限C3表格，要修改代码，谢谢老师

liulang0808

楼主雷同问题已经问过了，参考之前的案例看看吧

深秋红叶2019

liulang0808 发表于 2020-1-30 20:51
楼主雷同问题已经问过了，参考之前的案例看看吧

老师下拉选项已经会修改了，其它工作表的下拉效果都已经会改参数了，这次的问题是只要在制定的单元格实现下拉选项，不知道怎么改代码了

liulang0808

深秋红叶2019 发表于 2020-1-30 21:09
老师下拉选项已经会修改了，其它工作表的下拉效果都已经会改参数了，这次的问题是只要在制定的单元格实现 ...

仅仅是C3，手动设置是否可以？
其他会设置，单独设置一个C3的难点在哪里，楼主是差哪一步不了解？

深秋红叶2019

liulang0808 发表于 2020-1-30 21:28
仅仅是C3，手动设置是否可以？
其他会设置，单独设置一个C3的难点在哪里，楼主是差哪一步不了解？

If t.Row > 1 And t.Column = 3 Then   这个代码会把整个c列做成下拉选项效果，只要C3有就可以，数据有效性不太好，后面加数据的话下拉菜单就不会显示了
Dim sht As Worksheet, arr, d As Object, i%, s, r, r1, s1
         Set sht = Sheets("数据有效性")
         r = sht.Cells(Rows.Count, 1).End(3).Row
         arr = sht.Range("a1:a" & r)
         Set d = CreateObject("scripting.dictionary")
         For i = 2 To UBound(arr)
               s = arr(i, 1)
               If Not d.exists(s) Then
                    d(s) = ""
               End If
          Next i
          With Sheets("本期学员名单").Cells(t.Row, t.Column).Validation '在区域制作筛选下拉菜单
             .Delete
             .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(d.keys, ",")
         End With
         Erase arr: Set d = Nothing
    End If
End Sub

liulang0808

With Sheets("本期学员名单").[C3].Validation '在区域制作筛选下拉菜单
             .Delete
             .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(d.keys, ",")
         End With

楼主看看这样修改是否满足需求吧

深秋红叶2019

liulang0808 发表于 2020-1-30 21:28
仅仅是C3，手动设置是否可以？
其他会设置，单独设置一个C3的难点在哪里，楼主是差哪一步不了解？

还有那个“物品出入库记录”工作表显示方法和数据成员为找到，好像是Listbox1

深秋红叶2019

liulang0808 发表于 2020-1-30 21:38
With Sheets("本期学员名单").[C3].Validation '在区域制作筛选下拉菜单
             .Delete
          ...

好像多了7个表格有下拉菜单

liulang0808

深秋红叶2019 发表于 2020-1-30 21:48
好像多了7个表格有下拉菜单

楼主要做一个系统类的东西，建议提前规划好
6楼的修改就是在很对Sheets("本期学员名单").[C3]，这个一个单元格的

下面修改了事件，供参考
另外arr = sht.Range("a2:a" & r)如果是没有重复的，可以数组转一维数组直接使用。不用使用字典去重了
Private Sub Worksheet_Activate()
        Dim sht As Worksheet, arr, d As Object, i%, s, r, r1, s1
         Set sht = Sheets("数据有效性")
         r = sht.Cells(Rows.Count, 1).End(3).Row
         arr = sht.Range("a2:a" & r)
         Set d = CreateObject("scripting.dictionary")
         For i = 2 To UBound(arr)
               s = arr(i, 1)
               If Not d.exists(s) Then
                    d(s) = ""
               End If
          Next i
          With Sheets("本期学员名单").[c3].Validation '在区域制作筛选下拉菜单
             .Delete
             .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:=xlBetween, Formula1:=Join(d.keys, ",")
         End With
         Erase arr: Set d = Nothing

End Sub

深秋红叶2019

深秋红叶2019 发表于 2020-1-30 21:35
If t.Row > 1 And t.Column = 3 Then   这个代码会把整个c列做成下拉选项效果，只要C3有就可以，数据有效 ...

谢谢老师，已经可以了，非常感谢