Question

我有以下代码：

UserForm1列表框1填充了Worksheet1中的项目
UserForm2包含文本框和一个提交按钮
当我从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

遵循这些原则。由于不确定某些事情，在代码中留下了一些注释/查询。请注意如何处理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

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

2 个答案: