追加情報を含む新しいシートに情報を検索、切り取り、ペーストするユーザーフォーム

Question

私はVBAの初心者よりも少しだけ裸でいます。ワークシートには2つのユーザーフォームがあり、1つはクライアントを追加し、もう1つは削除します。 「クライアントの追加」は完璧に機能しますが、「クライアントの削除」は機能しません。私はブレークポイントを使用して私のコードが間違っていて、何が起きているのかを見るために、 "Private Sub OkButton2_Click（）"から "On Error GoTo Err_Execute"へと "If Range（" A "& CStr（LSearchRow） ）.Value = DCNameTextBox1.Value "すべて終わったら" End If "

ユーザーがクリックするとVBAが表示されます。[名前]ボックスに入力した内容を検索して、その行を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