在VBA中的2个工作簿中基于多个条件删除行

时间:2019-01-16 20:15:15

标签: excel vba

我有2本工作簿。 1个用作母版,1个用作每天从Oracle Cloud上耗尽,其中包含与Master Workbook有关的新信息。我想比较工作簿之间的两个值,如果有匹配项,请删除“主”电子表格中的相应行。有问题的列是两个工作簿中的A列,这是标识发票的唯一编号,而AB列是“ PAID”或“ UNPAID”,但仅应用于确定在工作簿之间应删除还是更新该行。 / p>

如果AB列中的值为“ PAID”并且在日常工作簿中(我们将其称为WB2),而WB2列A中的值位于“母版”中,则删除“母版”中的行。

下面是我当前得到的代码。我走了把两个范围都放在数组中的路线,然后希望做一些诸如检查数组中的值是否匹配(我之前已经做过)的事情,但是我不确定如何移动满足条件后,从正确的工作表中删除相应的行。

Public startCell As Range

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
  Dim i As Long
  Dim j As Integer
  j = 0

  For i = LBound(arr) To UBound(arr)
    If arr(i, 1) = stringToBeFound Then
        IsInArray = True
        j = 1
    End If
  Next i
  If j = 0 Then IsInArray = False
End Function

Sub AmendMaster()

Set startCell = ActiveWorkbook.Sheets("Main_Data").Cells(Rows.Count, 
"A").End(xlUp)

Dim mainRng As Range
Dim newRng As Range

Dim cell As Range

Dim mainArr As Variant

Dim wb As Workbook
Dim wbs(1) As Workbook


Dim i As Long
Dim j As Long
Dim RowMatch As Long
a = 0

Set mainRng = ActiveWorkbook.Sheets("Main_Data").Range("A2", ActiveWorkbook.Sheets("Main_Data").Cells(Rows.Count, "A").End(xlUp).Offset(0,27)) 'Column A is the Cust Transaction ID on the Main Report


mainArr = mainRng.Value

For Each wb In Workbooks

Set wbs(a) = wb
a = a + 1

Next wb

Set newRng = wbs(1).Sheets("Sheet1").Range("A3", wbs(1).Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Offset(0,28)) 'Column A is the Cust Transaction ID on the Daily Report
newArr = newRng.Value

For Each cell In mainRng
    cell.Value = cell.Value * 1
Next cell
For Each cell in newRng
    cell.Value = cell.Value * 1
Next cell

newRng.NumberFormat = "0"
newRng.NumberFormat = "0"

mainRng = newRng.Value


For i = 1 To UBound(newArr)
match = False
For j = 1 To UBound(mainArr)
    If newArr(i,28) = "PAID" And newArr(i,1) = mainArr(j,1) THEN 
        .Rows(i).Delete
    End If
Next i


End Sub

预期结果应该是,如果主电子表格在WB2中有10行,而在WB2中的那10行在AB列中也有“ PAID”,则VBA应该删除主电子表格中的10个匹配行。如果AB是“ UNPAID”,则尽管它可能匹配,但它只需要复制并覆盖主工作簿中A:V的所有列,但是出于这篇文章的目的,我只想着重于删除行非常确定我可以找出粘贴值。

任何帮助都会非常有用,因为我试图理解删除值,但不确定如何通过数组执行操作,甚至不确定解决此问题的最佳方法是什么,因此我完全欢迎任何提示或建议,以便我可以改善编码。

如果您还有什么需要我更好地了解问题或尝试的,请随时告诉我。

此致

马特

1 个答案:

答案 0 :(得分:0)

在VBA中丢失

无法确定发生了什么。抱歉。

Option Explicit

Public startCell As Range

Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean

    Dim i As Long

    For i = LBound(arr) To UBound(arr)
        If arr(i, 1) = stringToBeFound Then
            IsInArray = True
            Exit For
        End If
    Next

End Function

Sub AmendMaster()

    Const cSource As Variant = "Sheet1"     ' Source Worksheet Name/Index
    Const cSrc1 As Variant = "A"            ' Source Column 1 Letter/Number
    Const cSrc2 As Variant = "AC"           ' Source Column 2 Letter/Number
    Const cSrcFirstR As Long = 3            ' Source First Row Number

    Const cTarget As Variant = "Main_Data"  ' Target Worksheet Name/Index
    Const cTgt1 As Variant = "A"            ' Target Column 1 Letter/Number
    Const cTgt2 As Variant = "AB"           ' Target Column 2 Letter/Number
    Const cTgtFirstR As Long = 2            ' Target First Row Number

    Dim ws As Worksheet     ' Source Worksheet
    Dim rngU As Range       ' Union Range
    Dim vntSrc As Variant   ' Source Array
    Dim vntTgt As Variant   ' Target Array
    Dim srcLastR As Long    ' Source Last Row Number
    Dim tgtLastR As Long    ' Target Last Row Number
    Dim i As Long           ' Array Row Counter
    Dim j As Long

    With ThisWorkbook.Worksheets(cTarget)
        tgtLastR = .Cells(.Rows.Count, cTgt1).End(xlUp).Row
        vntTgt = .Range(.Cells(cTgtFirstR, cTgt1), .Cells(tgtLastR, cTgt2))
    End With

    For i = 1 To Workbooks.Count
        If Workbooks(i).Name <> ThisWorkbook.Name _
                And Windows(Workbooks(i).Name).Visible = True Then
            Debug.Print Workbooks(i).Name
            With Workbooks(i).Worksheets(cSource)
                srcLastR = .Cells(.Rows.Count, cSrc1).End(xlUp).Row
                vntSrc = .Range(.Cells(cSrcFirstR, cSrc1), _
                        .Cells(srcLastR, cSrc2))
            End With
            Exit For
        End If
    Next

    For i = 1 To UBound(vntSrc)
        For j = 1 To UBound(vntTgt)
            If vntTgt(i, UBound(vntTgt, 2)) = "PAID" _
                    And vntSrc(i, 1) = vntTgt(j, 1) Then
                With ThisWorkbook.Worksheets(cTarget)
                    .Rows(j).Hidden = True ' Delete
                End With
            End If
        Next
    Next

End Sub