Question

我的工作表中有两个UserForms，一个用于添加客户端，另一个用于删除。 “添加客户端”工作正常，但“删除客户端”不能。我使用断点来查看我的代码出错的地方以及似乎正在发生的事情是它从“Private Sub OkButton2_Click（）”跳到“On Error GoTo Err_Execute”和“If Range（”A“＆amp; CStr（LSearchRow）））。Value = DCNameTextBox1.Value然后“一直到”结束如果“

我希望VBA在用户点击Okay以搜索Name框中输入的内容，将该行从A切换到F（删除整行），将信息粘贴到表2中的下一个空行并添加用户放入用户表单的附加信息。我看过很多不同的代码和问题，但似乎没有一个能做到我想要的。

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

UserForm搜索，剪切和粘贴信息到新工作表上，附加信息

1 个答案: