Question

我想在主工作表上对总计进行验证。不同的总计应与工作簿中每个工作表的总计匹配（支持文档）。下面是我为工作表定义变量的代码，并命名了每个总数所在的范围。我想构建代码来执行以下操作： RecAR = ARbal吗？如果是，则以绿色有条件地格式化“确定”;如果不是，那么“差异”和条件格式为红色对于所有比较都应如此：

    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 ending来定义每个范围。枚举将简单地充当我们在数组中的位置的掩码，以便代码更易于阅读，调试和修改。它看起来像这样......

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

验证Master Sheet上的Grand Totals匹配支持工作表

1 个答案: