listbox更改问题，求指点！

高飞扬

0929.zip (19.98 KB, 下载次数: 14)

2018-9-12 15:55 上传

点击文件名下载附件

请路过的老师帮指点一下：   如图，原设计A列出现listbox 可以在ABC列出现选择性输入， 现想改为从E列输入，不知道该怎么改？  谢谢！

高飞扬

朱荣兴 发表于 2018-9-12 15:43
设置了VBA工程密码，没办法帮你的。

不好意思，重新上传了。

高飞扬

Private Sub ListBox1_click()
    With Me.ListBox1
        For i = 0 To .ListCount - 1
             If .Selected(i) Then s = .List(i)
        Next
    End With
    er = Cells(65536, "R").End(xlUp).Row
    r = Range("Q:Q").Find(s).Row
    Me.ListBox3.Clear
    Me.ListBox4.Clear
    For i = r To er
        If Cells(i, "Q") = s Or Cells(i, "Q") = "" Then
            If Cells(i, "R") <> "" Then Me.ListBox3.AddItem Cells(i, "R")
            If Cells(i, "S") <> "" Then Me.ListBox4.AddItem Cells(i, "S")
        Else
            Exit For
        End If
    Next
    For i = 1 To 4
        Me.OLEObjects("ListBox" & i).Visible = True
    Next
End Sub

Private Sub ListBox2_Click()
    With Me.ListBox2
        For i = 0 To .ListCount - 1
             If .Selected(i) Then s = .List(i)
        Next
    End With
    If Len(s) > 0 Then
        If Len(Cells(ActiveCell.Row, 1)) > 0 Then
            xyes = MsgBox("目标单元格数据存在，覆盖？", vbYesNo)
            If xyes = vbYes Then Cells(ActiveCell.Row, 1) = s
        Else
            Cells(ActiveCell.Row, 1) = s
        End If
    End If
End Sub

Private Sub ListBox3_Click()
With Me.ListBox3
        For i = 0 To .ListCount - 1
             If .Selected(i) Then s = .List(i)
        Next
    End With
    If Len(s) > 0 Then
        If Len(Cells(ActiveCell.Row, 2)) > 0 Then
            xyes = MsgBox("目标单元格数据存在，覆盖？", vbYesNo)
            If xyes = vbYes Then Cells(ActiveCell.Row, 2) = s
        Else
            Cells(ActiveCell.Row, 2) = s
        End If
    End If
End Sub

Private Sub ListBox4_Click()
With Me.ListBox4
        For i = 0 To .ListCount - 1
             If .Selected(i) Then s = .List(i)
        Next
    End With
    If Len(s) > 0 Then
        If Len(Cells(ActiveCell.Row, 3)) > 0 Then
            xyes = MsgBox("目标单元格数据存在，覆盖？", vbYesNo)
            If xyes = vbYes Then Cells(ActiveCell.Row, 3) = s
        Else
            Cells(ActiveCell.Row, 3) = s
        End If
    End If
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Target.Row >= 0 And Target.Column = 5 Then
        Me.ListBox1.Clear
        er = Cells(65536, "Q").End(xlUp).Row
        For i = 3 To er
            If Cells(i, "Q") <> "" Then Me.ListBox1.AddItem Cells(i, "Q")
        Next
        Me.ListBox2.Clear
        er = Cells(65536, "P").End(xlUp).Row
        For i = 3 To er
            If Cells(i, "P") <> "" Then Me.ListBox2.AddItem Cells(i, "P")
        Next
        t = Target.Offset(1, 1).Top + 1
        Me.ListBox1.Left = Target.Offset(1, 1).Left
        Me.ListBox1.Visible = True
        Me.ListBox2.Visible = True
        For i = 1 To 4
            With Me.OLEObjects("ListBox" & i)
                .Top = t
                If i > 1 Then .Left = Me.OLEObjects("ListBox" & i - 1).Left + Me.OLEObjects("ListBox" & i - 1).Width + 1
            End With
        Next
    Else
        For i = 1 To 4
            Me.OLEObjects("ListBox" & i).Visible = False
        Next
    End If
   End Sub
   

代码是上面这些。

liulang0808

Cells(ActiveCell.Row, 3)
这个后面的3对应的第三列，其他地方楼主可以根据需求参照修改

高飞扬

liulang0808 发表于 2018-9-12 18:18
Cells(ActiveCell.Row, 3)
这个后面的3对应的第三列，其他地方楼主可以根据需求参照修改

是的，可以了。就是改Cells(ActiveCell.Row, 1,2,3那里的问题。非常感谢！

高飞扬

好的，谢谢liulang0808老师！