ListView1横向读取+C2自动跳出下拉菜单

cmo9020

ListView1.rar (51.2 KB, 下载次数: 6)

2022-12-19 20:27 上传

点击文件名下载附件

各位导师晚上好~~~要询问有关.B2栏选择水泥，按下确定之后C2会自动跳出下拉菜单
菜单是SHEET2的水泥栏下(反绿色)
选择车辆就是车辆下面菜单
谢谢各位导师指导一下,谢谢





Private Sub Worksheet_change(ByVal Target As Range)
   Dim nL%, d, Arr, i%, m%, t
   Set d = CreateObject("scripting.dictionary")
   Arr = Sheet2.[a1].CurrentRegion
   For i = 2 To UBound(Arr)
      d(Arr(i, 1)) = d(Arr(i, 1)) & Arr(i, 2) & ","
Next
nL = Target.Column: m = Target.Row
If Target.Row < 7 Or nL <> 1 Or Target.Count > 1 Then Exit Sub
If d.exists(Target.Value) Then
  t = d(Target.Value)
With Cells(m, 2).Validation

   .Delete
   .Add 3, 1, 1, t
End With
Target.Offset(0, 1).Select
SendKeys "%{down}"
End If
End Sub

cmo9020

有大神会吗

洋务德雷

这个不需要编程吧，直接定义公司名称不就可以了吗？

cmo9020

洋务德雷 发表于 2022-12-20 08:19
这个不需要编程吧，直接定义公司名称不就可以了吗？

没想到这个我会了，谢谢

3190496160

Private Sub CommandButton1_Click()
With ListView1
    If .SelectedItem Is Nothing Then Exit Sub
    mc = .ListItems(.SelectedItem.Index).SubItems(1)
End With
With Sheet2
    Dim rng As Range
    Set rng = .Rows(1).Find(mc, , , , , , 1)
    If rng Is Nothing Then Exit Sub
    y = rng.Column
    r = .Cells(Rows.Count, y).End(xlUp).Row
    ar = .Range(.Cells(2, y), .Cells(r, y))
    ActiveCell.Value = mc
    ActiveCell.Offset(, 1).Select
    With Selection.Validation
        .Delete
        .Add Type:=xlValidateList, AlertStyle:=xlValidAlertStop, Operator:= _
        xlBetween, Formula1:="=" & mc
    End With
End With
Unload Me
End Sub

3190496160

ListView1.rar (52.47 KB, 下载次数: 13)

2022-12-20 10:12 上传

点击文件名下载附件

cmo9020

3190496160 发表于 2022-12-20 10:12
Private Sub CommandButton1_Click()
With ListView1
    If .SelectedItem Is Nothing Then Exit Sub

谢谢导师，只是想说横的列要怎麽读取，不过看样子我太难了