Excel VBA：匹配行数据并删除

Question

我必须每个月完成一些帐户调节，这可能会非常痛苦。基本上我运行一个报告，返回过去2个月内帐户中的所有交易。这份报告通常有几千行。除一个或两个例外之外的每个事务都应具有“反转”的原始TRX类型。例如，这是如何工作的，会计师将在2016年1月31日对此帐户进行借记输入，然后将撤消日期设置为2/1/2016。 2016年2月1日将自动生成相同的条目，但如果正确完成，则会将其转换为信用条目，以使条目余额在两个月之间达到零。但是，如果没有失败，会计师将不小心并使条目“标准”，并且不设置反向日期。因此，帐户中会留有未结余额。我的侦察的目的是找到这些错误的“标准”条目，这些条目没有撤销，通知会计师，并确保他们进行必要的更正条目。侦察中最痛苦的部分是通过正确完成的所有条目以找到少数不正确的条目。下面是报告的图片：

此报告的日期范围是01/01 / 2016-02 / 29/2016。 id能够做的是循环“日记帐分录”列并找到如下所示的匹配项：

您会注意到，第一笔交易的TRX日期为2016年1月31日，借方余额及其匹配的TRX日期为2016年1月2日和贷方余额。此条目已正确完成，我可以从报告中删除它。如果我有一个宏来处理这个步骤对我来说是理想的，因为它是最耗时的部分。我已经尝试过为此编写代码，但还没有提出任何可行的代码。以下是我的思考过程。

DataLastRow = Sheets(DataSheet).Range("A" & Rows.Count).End(xlUp).Row

Set JERange = Sheets(DataSheet).Range("C6:C" & DataLastRow)

For Each JE1 In JERange

'declare JE1's TRX Date
'declare JE1's JE #

Set SearchRange = Sheets(DataSheet).Range(Cell.Offset(1, 0).Address(False, False) & ":C" & DataLastRow)

For Each JE2 in SearchRange

'declare JE2's TRX Date
'declare JE2's JE #

'IF statement to check for matching JE #'s and Non-Matching TRX Dates between JE1 and JE2

Next JE2

Next JE1

我想首先突出显示比赛。任何帮助将不胜感激。

Answer 1

如果您只是需要找到只有一个JE编号的那个，这应该有帮助。这将计算JE的实例，将该数字放在另一列中并过滤＆＃34; 1＆＃34;

Sub test()

Dim w As Range
Dim iVal As Integer
lrow = Range("C5", Range("C" & Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible).Count

For Each w In Range("C5:C" & lrow).Cells
    iVal = Application.WorksheetFunction.CountIf(Range("C5:C" & lrow), w.Value)
    w.Offset(0, 1).Value = iVal  '<---change this offset to an empty column
Next w

'change this to filter on the column you set above in the offset
'change "fields:=2" to the field that shows the count
Worksheets("Sheet1").Range("C5").AutoFilter field:=2, Criteria1:="1", VisibleDropDown:=False
End Sub

Answer 2

假设您想要重复＆＃34;重复＆＃34;根据这个条件：

1. [Credit Amount]等于[Debit Amount]

对于大数据量，我建议使用ADODB.Recordset，这将比通过单元格的任何循环快得多。

参见示例宏：

Option Explicit

Sub GetSpecificRows()
'declare variables
Dim oConn As ADODB.Connection
Dim oRst As ADODB.Recordset
Dim sConn As String
Dim sFileName As String
Dim sQry As String

'on error go to error handler
On Error GoTo Err_GetSpecificRows

'get the current file name (containing this macro)
sFileName = ThisWorkbook.FullName
'define connection string
sConn = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sFileName & ";Extended Properties='Excel 12.0 Macro;HDR=YES';"
'set query statement
sQry = "SELECT A.[TRX Date], A.[Journal Entry], A.[Debit Amount], A.[Credit Amount]" & vbCr & _
        "FROM [DataSheet$B5:H20] AS A INNER JOIN (" & vbCr & _
            "SELECT [TRX Date], [Journal Entry], [Debit Amount], [Credit Amount]" & vbCr & _
            "FROM [DataSheet$B5:H20]" & vbCr & _
            ") AS B ON A.[Journal Entry] =  B.[Journal Entry] AND A.[Debit Amount] = B.[Credit Amount]"

'create and open connection
Set oConn = New ADODB.Connection
With oConn
    .ConnectionString = sConn
    .Open
End With

'create and open recordset
Set oRst = New ADODB.Recordset
oRst.Open Source:=sQry, ActiveConnection:=oConn, CursorType:=adOpenStatic, LockType:=adLockReadOnly

'MsgBox sQry, vbInformation, oRst.RecordCount

'clear destination sheet
ThisWorkbook.Worksheets(2).Range("B6:E20").Clear
'copy data from recordset
ThisWorkbook.Worksheets(2).Range("B6").CopyFromRecordset oRst

'exit instructions
Exit_GetSpecificRows:
    On Error Resume Next
    If Not oRst Is Nothing Then oRst.Close: Set oRst = Nothing
    If Not oConn Is Nothing Then oConn.Close: Set oConn = Nothing
    Exit Sub

'error handler
Err_GetSpecificRows:
    MsgBox Err.Description, vbExclamation, Err.Number
    Resume Exit_GetSpecificRows

End Sub

注意：上面的代码正在搜索满足条件的数据，并将这些数据复制到同一工作簿中的另一个工作表中。如果您想执行删除操作，则需要创建ADODB.Command。

有关详细信息，请参阅：
ADODB.Connection
ADODB.Recordset
connectionstrings for Excel

Answer 3

感谢您的帮助！我很快就把它打得很好，效果很好：

Set JERange = Sheets(DataSheet).Range("C6:C" & DataLastRow)

For Each JE1 In JERange

JEMatch = False
TRXTypeMatch = False
TRXDateNoMatch = False

JENum1 = JE1.Value
TRXDate1 = JE1.Offset(0, -1).Value
TRXType1 = JE1.Offset(0, 10).Value

Set SearchRange = Sheets(DataSheet).Range(JE1.Offset(1, 0).Address(False, False) & ":C" & DataLastRow)

For Each JE2 In SearchRange

JEMatch = False
TRXTypeMatch = False
TRXDateNoMatch = False

JENum2 = JE2.Value
TRXDate2 = JE2.Offset(0, -1).Value
TRXType2 = JE2.Offset(0, 10).Value


If JENum1 = JENum2 Then
JEMatch = True
End If

If TRXDate1 <> TRXDate2 Then
TRXDateNoMatch = True
End If

If TRXType1 = TRXType2 Then
TRXTypeMatch = True
End If

If JEMatch = True And TRXDateNoMatch = True And TRXTypeMatch = True Then

  JE1.Select
  With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 65535
    .TintAndShade = 0
    .PatternTintAndShade = 0
End With

  JE2.Select
  With Selection.Interior
    .Pattern = xlSolid
    .PatternColorIndex = xlAutomatic
    .Color = 65535
    .TintAndShade = 0
    .PatternTintAndShade = 0
  End With

End If

Next JE2

Next JE1