listview1打勾框要怎么样弄成一行

cmo9020

ListView2.rar (26.69 KB, 下载次数: 16)

2022-12-21 21:41 上传

点击文件名下载附件

各位大神导师晚上好....
请问一下,listview1打勾框要怎么样弄成一行
(像图二一样)
勾选后,要填入C行单元格内,目前只有显示 " , "
需要修改哪些地方,搞不定....请帮忙一下,谢谢导师们

图二↓


Dim arr
Private Sub CommandButton1_Click()
    Dim sd As String, y As Long, j As Long

    With ListView1.ListItems
        y = .Count
        If y = 0 Then
            MsgBox "No items were selected!"
            Exit Sub
        End If

        j = 1
        For x = 1 To y
            If .Item(x).Checked = True Then
                If j = 1 Then
                    sd = .Item(x).SubItems(1)
                Else
                    sd = sd & "," & .Item(x).SubItems(1)
                End If
                j = j + 1
            End If
        Next
    End With

    ActiveCell = sd
    Unload Me
End Sub


Private Sub UserForm_Initialize()
    arr = Sheet2.Range("c1").CurrentRegion
    For i = 1 To UBound(arr, 2)
        ComboBox1.AddItem arr(1, i)
    Next
  With ListView1
     .ColumnHeaders.Clear
     .ListItems.Clear
     .ColumnHeaders.Add 1, , "", .Width / 3
     .ColumnHeaders.Add 2, , "", .Width / 0.57
     .View = lvwReport
     .Gridlines = True
     .FullRowSelect = True
     .MultiSelect = True
  End With


End Sub


Private Sub ComboBox1_Change()

s = Me.ComboBox1.Text
Me.ListView1.ListItems.Clear
If Len(s) Then
    For i = 1 To UBound(arr, 2)
        If arr(1, i) = s Then
            For j = 2 To UBound(arr)
                If Len(arr(j, i)) Then Me.ListView1.ListItems.Add.Text = arr(j, i)
            Next
            Exit For
         End If
    Next
End If
End Sub

cmo9020

哈囉，导师们早安@有会的导师帮忙吗...

02761752696

cmo9020 发表于 2022-12-22 07:13
哈囉，导师们早安@有会的导师帮忙吗...

注意区分行列，那不叫一行

02761752696

cmo9020 发表于 2022-12-22 07:13
哈囉，导师们早安@有会的导师帮忙吗...

参照修改

02761752696

02761752696

无聊 ......

cmo9020

02761752696 发表于 2022-12-22 07:55

好的，导师，谢谢您，我在玩玩看

cmo9020

02761752696 发表于 2022-12-22 08:17
无聊 ......

ListView.rar (20.04 KB, 下载次数: 14)

2022-12-22 18:25 上传

点击文件名下载附件

导师居然说无聊,在请教导师一下
玩了一下做变动
需求像是
B栏输入项目之后，C栏自动跳出UserForm3的lstivew1
把Sheet2的反绿色带入

变成像图片这样子
等于没有ComboBox1,,,B栏输入项目之后，C栏自动显示lstivew1
现在代码修改后,lstivew1只带的出水果部份....
是哪儿弄错了...
在请导师教一下,谢谢您





Private Sub CommandButton1_Click()
    Dim sd As String, y As Long, j As Long

    With ListView1.ListItems
        y = .Count
        If y = 0 Then
            MsgBox "No items were selected!"
            Exit Sub
        End If

        j = 1
        For x = 1 To y
            If .item(x).Checked = True Then
                If j = 1 Then
                    sd = .item(x).SubItems(1)
                Else
                    sd = sd & "," & .item(x).SubItems(1)
                End If
                j = j + 1
            End If
        Next
    End With



    ActiveCell = sd
    Unload Me
End Sub


Private Sub UserForm_Initialize()

    arr = Sheet2.Range("c1").CurrentRegion

    With ListView1
        .ColumnHeaders.Clear
        .ListItems.Clear
        .ColumnHeaders.Add 1, , "", .Width / 3
        .ColumnHeaders.Add 2, , "", .Width / 0.57
        .View = lvwReport
        .Gridlines = True
        .FullRowSelect = True
        .MultiSelect = True


        For i = 2 To UBound(arr)
            If Len(arr(i, 1)) Then Me.ListView1.ListItems.Add.SubItems(1) = arr(i, 1)
        Next
    End With
End Sub

02761752696

cmo9020 发表于 2022-12-22 18:26
导师居然说无聊,在请教导师一下
玩了一下做变动
需求像是

根据B列的值输入对应的数据

cmo9020

02761752696 发表于 2022-12-22 21:27
根据B列的值输入对应的数据

漂亮的导师,我塞好久塞不进去,代码是调整    arr = Sheet2.Range("c1").CurrentRegion吗?我改好久,麻烦您指导一下,谢谢您