Question

这就是我想要做的事情：

我有两张名为Pending＆amp; amp;的工作表。记录。
“待处理”工作表中的列：A：日期，B：交付到，C：交付到办公室，D：交付给经理，E：主题，F：日期＆amp; G：信件编号
“记录”工作表中的列：A：日期，B：字母编号＆amp; 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

将以下代码放入＆＃34;待定＆＃34;工作表模块，在Worksheet_Change事件下。

首先，您应该学会享受Target变量带来的好处。

例如，如果你想复制一个值＆＃34; F＆＃34;在同一行的＃G;＃34; （您的Target），您可以使用Target.Offset(, -1).Copy。

如果您要复制Target后的整个行，只需使用Target.EntireRow.Delete。

另一件事，根据您的屏幕截图（以及您帖子的第一部分）＆＃34; Letter No＆＃34;位于Column＆＃34; B＆＃34; in＆＃34; Records＆＃34;片。因此，Sort根据列＆＃34; B＆＃34;。

完成

<强>代码

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

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

1 个答案: