复制和删除选定的列表框项目

Question

我的代码是：

UserForm1 列表框 1 填充它来自 Worksheet1 的项目
UserForm2 包含文本框和一个提交按钮
当我 select 来自 UserForm1 ListBox1 的项目时，它将值复制到 UserForm2 文本框

我想，当我进入 UserForm 2 并单击提交按钮时，Worksheet1 中的行移动到 Worksheet2

下面是 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

Answer 1

类似的东西。在代码中留下了一些 comments/queries 作为不确定的一些事情。请注意如何处理 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

Answer 2

我已经找到丢失的东西了。这段时间只是

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

复制和删除选定的列表框项目

Copy and delete selected listbox item

excel

vba

listbox

userform