Delete/Add 基于来自其他 sheet 的查找值的行

Question

我在同一个工作簿中有两张纸。 Sheet 2是“DCT账户”。 Sheet 1 是“DCT”。

如果“DCT 账户”中的 J 列显示“添加账户”，我想将“DCT 账户”中的 A、B 和 C 列附加到“DCT”的底部。

如果“DCT 账户”中的 K 列显示“关闭账户”，我想从“DCT”中删除整行。

我创建了以下从“DCT 帐户”到“DCT”的查找。如何根据列 J 和 K 添加或删除行？

=IFERROR(VLOOKUP('DCT Accounts'!A4,DCT!B:B,1,0),VLOOKUP('DCT Accounts'!B4,DCT!B:B,1,0))

两个工作表中的数据都从第 4 行开始。

DCT

DCT 账户

“DCT 帐户”是同一个故事，700 多行，但我们使用 D 列作为查找（这是一个公式），但给了我们想要的查找。

Answer 1

你没有回答我的澄清问题...

所以，请测试下一个代码，完全按照您的建议进行设计。它应该非常快，使用数组，因此，在内存中工作并立即删除行：

Sub DeleteAddRow()
 Dim wsDA As Worksheet, wsD As Worksheet, lastRDA As Long, lastRD As Long
 Dim arrDA As Variant, rngDel As Range, arrD As Variant, arrCopy As Variant
 Dim i As Long, j As Long, k As Long
 
 Set wsDA = Worksheets("DCT Accounts")
 Set wsD = Worksheets("DCT")
 lastRDA = wsDA.Range("A" & rows.count).End(xlUp).row
 lastRD = wsD.Range("A" & rows.count).End(xlUp).row
 
 arrDA = wsDA.Range("A4:K" & lastRDA).Value 'place the range in an array
 arrD = wsD.Range("A4:K" & lastRDA).Value   'place the range in an array
 
 ReDim arrCopy(1 To 3, 1 To UBound(arrDA))  'initially redim the array but transposed
                                            'transposed to allow redim preserve to
                                            'the last dimension
 For i = 1 To UBound(arrDA)
    If arrDA(i, 10) = "Add Account" Then
        k = k + 1: arrCopy(1, k) = arrDA(i, 1): arrCopy(2, k) = arrDA(i, 2)
        arrCopy(3, k) = arrDA(i, 3)        'fill the array with the data to be copied
    End If
    If arrDA(i, 11) = "Close Account" Then
        For j = 1 To lastRD
            If arrDA(i, 4) = arrD(j, 2) Then 'create the range to be deleted at once
                If rngDel Is Nothing Then
                    Set rngDel = wsD.Range("A" & j + 3)
                Else
                    Set rngDel = Union(rngDel, wsD.Range("A" & j + 3))
                End If
                Exit For
            End If
        Next j
    End If
 Next i
 if k > 0 Then ReDim Preserve arrCopy(1 To 3, 1 To k)   'keep in the array only non empty elements
 If Not rngDel is Nothing Then rngDel.EntireRow.Delete xlUp             'delete the range at once (very fast)
 lastRD = wsD.Range("A" & rows.count).End(xlUp).row 'determine the last row after deletion
 'drop the array values to the last empty row:
 If k > 0 Then
      wsD.Range("A" & lastRD + 1).Resize(k, 3).Value = _
              WorksheetFunction.Transpose(arrCopy)
 End If
End Sub

从程序的角度来看，我认为在数组中输入范围后，从 sheet 中清除“添加帐户”或将其替换为“添加帐户”之类的内容会很好。这样做，是为了避免运行对同一个数据两次编码，在“DCT”中对同一个账户重复两次。

但是，首先您最好检查确定要复制的范围的逻辑（从 D 列，或从 B 列...）。

Delete/Add 基于来自其他 sheet 的查找值的行

Delete/Add Row based upon Lookup Value From other sheet

excel

vba

append

delete-row