验证主表匹配的总计与支持工作表

Question

我想对主表上的总数进行验证。不同的总数应与工作簿(辅助文档)中每个工作表的总数相匹配。下面是我为工作表定义了变量的代码，并命名了每个总数所在的范围。我想构建代码来执行以下操作: RecAR = ARbal吗？如果是，则在绿色中有条件地格式化"OK“；如果不是，则应该对所有的比较执行以下操作：

    RecAR = ARbal
    RecTB1 = TBbal1
    RecJE1 = JEnb1
    RecPP = PPbal
    RecTB2 = TBbal2
    RecJE2 = JEnb2

母版是“和解”版。总数列在D、E、F、H、I、J列中，并将位于A列中填充"Grand Total“的同一行。在本例中，它位于第15386行，但这将因月而异。我希望主对账表上的总数在下面的验证。

    Sub RecValidation()
'Goal is to create a validation check to ensure all data transfered from supporting docs to
'recon template
'
'Set up worksheet variables for supporting tabs
Dim Aged As Worksheet
Dim TB1 As Worksheet
Dim TB2 As Worksheet
Dim JEAR As Worksheet
Dim JEPP As Worksheet

Set Aged = Sheets("Aged AR")
Set TB1 = Sheets("TB 1260 AR")
Set TB2 = Sheets("TB 2255 Prepaid")
Set JEAR = Sheets("JEs 1260 AR")
Set JEPP = Sheets("JEs 2255 Prepaid")

    'Set up Range variables for the grandtotals for each column with amounts on recon template that come from supporting docs
    Dim RecAR As Range
    Dim RecTB1 As Range
    Dim RecJE1 As Range
    Dim RecPP As Range
    Dim RecTB2 As Range
    Dim RecJE2 As Range

    Set RecAR = Columns("A").Find("Grand Total", LookAt:=xlPart).Offset(0, 3)
    Set RecTB1 = RecAR.Offset(0, 1)
    Set RecJE1 = RecAR.Offset(0, 2)
    Set RecPP = RecAR.Offset(0, 4)
    Set RecTB2 = RecAR.Offset(0, 5)
    Set RecJE2 = RecAR.Offset(0, 6)

'Set up Range variables for the grandtotals for each supporting document
Dim ARbal As Range
Dim PPbal As Range
Dim TBbal1 As Range
Dim TBbal2 As Range
Dim JEnb1 As Range
Dim JEnb2 As Range

'The headers may be in a merged cell therefore I'm offsetting a few rows down then using xlDown
'to get to the row with the total.  All supporting documentation will have the totals the next
'row below the last row of data
Set ARbal = Aged.Cells.Find("Charges", LookAt:=xlPart).Offset(5, 0).End(xlDown)
Set PPbal = Aged.Cells.Find("Prepays", LookAt:=xlPart).Offset(5, 0).End(xlDown)
Set TBbal1 = TB1.Cells.Find("Tenant", LookAt:=xlPart).Offset(5, 0).End(xlDown)
Set TBbal2 = TB2.Cells.Find("Tenant", LookAt:=xlPart).Offset(5, 0).End(xlDown)
Set JEnb1 = JEAR.Cells.Find("Net Activity", LookAt:=xlPart).End(xlDown)
Set JEnb2 = JEPP.Cells.Find("Net Activity", LookAt:=xlPart).End(xlDown)

Answer 1

好吧，我想我已经把你想做的事搞得头昏脑胀了。我的第一个建议是建立一个循环。我觉得那样会更干净。为了设置一个循环，您需要使用一个具有枚举的收尾来定义您的每个范围。Enum将简单地充当数组中我们位置的掩码，这样代码就更容易读取、调试和修改。看起来会像这样..。

Public Enum rangeNames
     AR = 1
     TB1 = 2
     JE1 = 3
     PP = 4
     TB2 = 5
     JE2 = 6
     [_EndPlaceholder] 
     finalValue = [_EndPlaceholder] - 1
End Enum

因此，现在您要将两个范围定义为一个范围数组。当我们到达循环时，这将变得很明显为什么。想象一下这里使用的rangeNames.Xs作为数字的掩码。Set recRanges(rangeNames.JE1)和Set recRanges(3)是一样的。

Dim recRanges() as Range
Dim balRanges() as Range
ReDim recRanges(rangeNames.finalValue)
ReDim balRanges(rangeNames.finalValue)
Set recRanges(rangeNames.AR) = Columns("A").Find("Grand Total", LookAt:=xlPart).Offset(0,3)
Set recRanges(rangeNames.TB1) = recRange(rangeNames.AR).Offset(,1)
Set recRanges(rangeNames.JE1) = recRange(rangeNames.AR).Offset(,2)
Set recRanges(rangeNames.PP) = recRange(rangeNames.AR).Offset(,4)
Set recRanges(rangeNames.TB2) = recRange(rangeNames.AR).Offset(,5)
Set recRanges(rangeNames.JE2) = recRange(rangeNames.AR).Offset(,6)
Set balRanges(rangeNames.AR) = Aged.Cells.Find("Charges", LookAt:=xlPart).Offset(5, 0).End(xlDown)
Set balRanges(rangeNames.PP) = Aged.Cells.Find("Prepays", LookAt:=xlPart).Offset(5, 0).End(xlDown)
Set balRanges(rangeNames.TB1) = TB1.Cells.Find("Tenant", LookAt:=xlPart).Offset(5, 0).End(xlDown)
Set balRanges(rangeNames.TB2) = TB2.Cells.Find("Tenant", LookAt:=xlPart).Offset(5, 0).End(xlDown)
Set balRanges(rangeNames.JE1) = JEAR.Cells.Find("Net Activity", LookAt:=xlPart).End(xlDown)
Set balRanges(rangeNames.JE2) = JEPP.Cells.Find("Net Activity", LookAt:=xlPart).End(xlDown)

现在是为了魔法。让我们循环这些坏男孩，并做我们的比较

Dim x as Integer
For x = 1 to rangeNames.finalValue
     'Let's do a quick check to make sure we haven't missed a range
     If (recRanges(x) Is Nothing) Or (balRanges(x) Is Nothing) Then
          MsgBox "Error on the rangeNames Enum with value " + CStr(x) + "."
          Exit Sub
     End If
     'I am just assuming you want your OK/Difference at the following range.
     'You may have to adjust it if you want it elsewhere
     Dim resultRange as Range
     Set resultRange = recRanges(x).Offset(1)
     If recRanges(x) = balRanges(x) Then
          resultRange.Value = "OK"
          resultRange.Interior.Color = RGB(0,255,0)
     Else
          resultRange.Value = "Difference"
          resultRange.Interior.Color = RGB(255,0,0)
     End If
Next x

编辑回应评论中的问题

如果其中一个值是另一个值的负值，则有两种处理方法。如果其他任何比较都不可能是确切的负数，那么您只需替换这一行

If recRanges(x) = balRanges(x) Then

有了这个

If Abs(recRanges(x)) = Abs(balRanges(x)) Then

Abs()只是绝对值函数，它忽略了负号。如果存在recRanges和balRanges之一是相加反比的可能性，那么是的，您必须设置一个IF语句。

 If x = rangeNames.TB2 Then
      'Let's make sure recRanges and balRanges contain a number
      If ((IsNumeric(recRanges(x).Value) = False) Or _
          (IsNumeric(balRanges(x).Value) = False)) Then
           MsgBox "Error in TB2 ranges, either the recRange or balRange is not a number."
           Exit Sub
      End If
      If recRanges(x).Value = (-1 * CDbl(balRanges(x).Value)) Then
           resultRange.Value = "OK"
           resultRange.Interior.Color = RGB(0,255,0)
      Else
           resultRange.Value = "Difference"
           resultRange.Interior.Color = RGB(255,0,0)          
      End If
 Else
      If recRanges(x) = balRanges(x) Then
           resultRange.Value = "OK"
           resultRange.Interior.Color = RGB(0,255,0)
      Else
           resultRange.Value = "Difference"
           resultRange.Interior.Color = RGB(255,0,0)
      End If
 End If