复制并删除所选的列表框项目

Posted 2021-04-18

我的代码是：

1. UserForm1 Listbox1从Worksheet 1填充其项目
2. UserForm2包含文本框和提交按钮
3. 当我从UserForm1 ListBox1中选择一个项目时，它将值复制到UserForm2 Textboxes

我想，当我进入UserForm 2并单击提交按钮时，工作表1中的行移动到工作表2

下面是UserForm1 ListBox1中的代码

Private Sub UserForm1ListBox1_Click()
    With UserForm2
        .TextBox1 = ListBox1.Column(0)
        .TextBox2 = ListBox1.Column(1)
        .TextBox3 = ListBox1.Column(2)
        .TextBox4 = ListBox1.Column(3)
        .TextBox5 = ListBox1.Column(4)
    End With
End Sub

下面是UserForm2提交按钮中的代码。在代码中评论错误。

Private Sub Userform2SubmitButton_Click() 
    Dim i As Long

    For i = UserForm1.ListBox1.ListCount - 1 To 0 Step -1
        If UserForm1.ListBox1.Selected(i) Then

            Worksheets("Worksheet1").Range("A" & i + 1). _
            Copy Worksheets("Worksheet2").Range("A" & Rows.Count).End(xlUp).Offset(0)

            If UserForm1.ListBox1.ListIndex >= 0 Then
            LastRow = Worksheets("Worksheet1").Cells(Rows.Count, "A").End(xlUp).Row

            Worksheets("Worksheet1").Range("A" & LastRow).Find(what:=UserForm1.ListBox1.Value, LookIn:=xlValues, LookAt:=xlWhole).Activate   '<------------------error here!
            Worksheets("Worksheet1").Rows(ActiveCell.Row).Delete

        End If
     End If
    Next i
End Sub

答案

沿着这些方向的东西。在代码中留下了一些注释/查询，因为不确定一些事情。请注意如何处理Find找不到任何东西的可能性。

Private Sub Userform2SubmitButton_Click()

Dim i As Long, r As Range, ws As Worksheet

Set ws = Worksheets("Worksheet1")

For i = UserForm1.ListBox1.ListCount - 1 To 0 Step -1
    If UserForm1.ListBox1.Selected(i) Then
        ws.Range("A" & i + 1).Copy _
              Worksheets("Worksheet2").Range("A" & Rows.Count).End(xlUp).Offset(1) 'changed offset to 1 so as not to overwrite
        If UserForm1.ListBox1.ListIndex >= 0 Then
            LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row 'not sure what this is for
            Set r = ws.Cells.Find(what:=UserForm1.ListBox1.Value, LookIn:=xlValues, LookAt:=xlWhole)
            If Not r Is Nothing Then 'avoid error if nothing found
                r.EntireRow.Delete
            End If
        End If
    End If
Next i

End Sub

另一答案

我设法找出了遗漏的东西。所有这一切都是公正的

Sheets("Worksheet1").Select

对于想要使用它的人，我已将此添加到我的原始代码中。感谢SJR的帮助。

Private Sub Userform2SubmitButton_Click() 
    Dim i As Long
    Sheets("Worksheet1").Select
    For i = UserForm1.ListBox1.ListCount - 1 To 0 Step -1
        If UserForm1.ListBox1.Selected(i) Then

            Worksheets("Worksheet1").Range("A" & i + 1). _
            Copy Worksheets("Worksheet2").Range("A" & Rows.Count).End(xlUp).Offset(0)

            If UserForm1.ListBox1.ListIndex >= 0 Then
            LastRow = Worksheets("Worksheet1").Cells(Rows.Count, "A").End(xlUp).Row

            Worksheets("Worksheet1").Range("A" & LastRow).Find(what:=UserForm1.ListBox1.Value, LookIn:=xlValues, LookAt:=xlWhole).Activate   '<------------------error here!
            Worksheets("Worksheet1").Rows(ActiveCell.Row).Delete

        End If
     End If
    Next i
    End Sub