Excel VBA宏复制特定行并将其删除

Question

这是我想做的:

我有 2 个名为 Pending & Records 的工作表。

“待处理”工作表中的列:A:日期，B:交付至，C:交付至办公室，D:交付至经理，E:主题，F:日期和 G:字母编号

“记录”工作表中的列:A:日期，B:字母编号和 C:主题。

当在“待处理”工作表的单元格 G(字母编号)中输入数字时，以下单元格将复制到“记录”工作表中的指定单元格。

“待处理”工作表中的 E(主题)位于“记录”工作表的 C(主题)中。

“待处理”工作表中的 F(日期)位于“记录”工作表的 A(日期)中。

“待处理”工作表中的 G(字母编号)位于“记录”工作表的 B(字母编号)中。

删除在“待定”工作表中复制的行。

根据字母编号(C 列)对“记录”工作表中的行进行排序。

这是我为我想做的事情编写的代码(效果不好)和一些截图:

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Column = 6 Then
    If Len(Target.Value) > 0 Then
        Dim r As Range
        Dim a As String
        Dim b As String

        b = "sheet3!A" & Sheet1.Cells(1, 9) + 3 & ":C" & Sheet1.Cells(1, 9) + 3
        a = "E" & Target.Row & ":G" & Target.Row
        Dim r1, r2 As Range
        r1 = Sheet1.Range(a)
        Sheet2.Range(b).Value = r1
        Sheet1.Range(a).EntireRow.Delete
    End If
End If

End Sub

picture 1
picture 2

Answer 1

将下面的代码放在“待处理”工作表模块中，Worksheet_Change 下事件。

首先，你应该学会享受Target的好处。多变的。

例如，如果您想从“G”列的同一行(您的 Target)复制“F”列中的值，您可以使用 Target.Offset(, -1).Copy .

如果你想删除你的 Target 的整行复制后，只需使用Target.EntireRow.Delete .

另一件事，根据您的屏幕截图(以及您帖子的第一部分)，“字母编号”位于“记录”表的“B”列。因此，Sort根据“B”栏完成。

代码

Option Explicit

Private Sub Worksheet_Change(ByVal Target As range)

Dim RecSht      As Worksheet
Dim NextRow     As Long

Application.ScreenUpdating = False
Application.EnableEvents = False

If Target.Column = 7 Then ' Column "G"
    If Target.Value <> "" Then
        Set RecSht = Worksheets("Records")
        NextRow = RecSht.Cells(RecSht.Rows.Count, "A").End(xlUp).Row + 1 ' <-- get next empty row at Column A in "Records" sheet

        RecSht.Range("B" & NextRow).Value = Target.Value ' column "G"
        RecSht.Range("A" & NextRow).Value = Target.Offset(, -1).Value ' column "F"
        RecSht.Range("C" & NextRow).Value = Target.Offset(, -2).Value ' column "E"

        Target.EntireRow.Delete ' <-- Delete entire row that was copied

        '--- Sort Section ---
        RecSht.Range("A2:C" & NextRow).Sort key1:=RecSht.Range("B2:B" & NextRow), _
                                         order1:=xlAscending, Header:=xlYes
    End If
End If

Application.EnableEvents = True
Application.ScreenUpdating = True

End Sub