使用附加信息搜索、剪切和粘贴信息到新 Sheet 的用户表单

Question

我的工作中有两个用户表单sheet，一个用于添加客户，一个用于删除。 "Add Client" 工作完美，但 "Remove Client" 不完美。我已经使用断点来查看我的代码哪里出错了，似乎发生了什么是它从 "Private Sub OkButton2_Click()" 跳到 "On Error GoTo Err_Execute" 和 "If Range("A" & CStr(LSearchRow)).Value = DCNameTextBox1.Value 然后”一直到 "End If"

我希望 VBA 在用户单击“确定”时搜索“名称”框中输入的内容，将该行从 A 剪切到 F（删除整行），将信息粘贴到下一个空白处row in sheet 2 并添加用户在用户表单中输入的附加信息。我看过很多不同的代码和问题，其中 none 似乎完全符合我的要求。

Private Sub OkButton2_Click()

    Dim emptyRow As Long
    Dim LSearchRow As Integer
    Dim LCopyToRow As Integer

   On Error GoTo Err_Execute

   'Start search in row 3
   LSearchRow = 3

   'Start copying data to row 3 in Sheet2 (row counter variable)
   LCopyToRow = 3

   While Len(Range("A" & CStr(LSearchRow)).Value) > 0

      'If value in column A = "Client Name", copy entire row to Sheet2
      If Range("A" & CStr(LSearchRow)).Value = DCNameTextBox1.Value Then

         'Select row in Sheet1 to copy
         Rows(CStr(LSearchRow) & "A:F" & CStr(LSearchRow)).Select
         Selection.Copy

         'Paste row into Sheet2 in next row
         Sheets("Sheet2").Select
         Rows(CStr(LCopyToRow) & "A:F" & CStr(LCopyToRow)).Select
         ActiveSheet.Paste
        'Add/Transfer Discharge info
        Sheets("Sheet2").Cells(emptyRow, 7).Value = DCDateTextBox.Value
        Sheets("Sheet2").Cells(emptyRow, 8).Value = DispoTextBox.Value
        Sheets("Sheet2").Cells(emptyRow, 9).Value = ReasonTextBox.Value

         'Move counter to next row
         LCopyToRow = LCopyToRow + 1

         'Go back to Sheet1 to continue searching
         Sheets("Sheet1").Select


      End If

      LSearchRow = LSearchRow + 1

   Wend

   'Position on cell A3
   Application.CutCopyMode = False
   Range("A3").Select

   MsgBox "Client has been moved to Discharge list."

   Exit Sub

Err_Execute:
   MsgBox "An error occurred."

End Sub

Answer 1

使用Range.Find效率更高一些。

Private Sub OkButton2_Click()
    Dim Source As Range, Target As Range
    With Worksheets("Sheet1")
        Set Source = .Range("A3", .Range("A" & .Rows.Count).End(xlUp))
    End With

    Set Target = Source.Find(What:=DCNameTextBox1.Value, LookIn:=xlValues, LookAt:=xlWhole)

    If Not Target Is Nothing Then
        'Reference the next enmpty row on Sheet2
        With Worksheets("Sheet2")
            With .Range("A" & .Rows.Count).End(xlUp).Offset(1)
                '.Range("A1:F1") is relative to the row of it's parent range
                .Range("A1:F1").Value = Target.Range("A1:F1").Value
                .Range("H1:J1").Value = Array(DCDateTextBox.Value, DispoTextBox.Value, ReasonTextBox.Value)

                Set Source = .Range("A3", .Range("A" & .Rows.Count).End(xlUp))
            End With
        End With
        Target.Range("A1:F1").Delete Shift:=xlShiftUp
        MsgBox "Client has been moved to Discharge list."
    Else
        MsgBox "Client not found", vbInformation, "No Data"
    End If

    Range("A3").Select
End Sub

使用附加信息搜索、剪切和粘贴信息到新 Sheet 的用户表单

UserForm to Search for, Cut, and Paste info onto new Sheet with Additional Info

excel

vba

paste