如果在另一个工作簿中找到或未找到单元，则创建各种范围

我一直在努力工作一天半的代码。我有一个超过50列18000行的电子表格。我已经能够基于H（OpsCol）列中的空白单元格来确定由“ AllEntRg”定义的A列中较小范围的单元格。我陷入循环的底部。对于EntityRg，我将遍历“ AllEntRg”中的每个单元格，如果未在BudWb Wk4中定义的Range CCRg中找到它，那么我想创建所有这些单元格的范围。下一个选项CostCRg，我想为CCrg中找到的所有单元格定义一个范围。

我已经通过选择单个单元格对其进行了测试，它提供了我想要的结果，但是当我将其放入循环中时，我得到了以下两个结果：对于EntityRg，定义的range.address与AllEntRg相同（这是情况并非如此）。对于CostCRg，我遇到了错误。我不确定我没有正确定义。我已经在这里停留了很长一段时间，并且也尝试过使用Match Function。同样，单独运行也可以，但是在循环中，我得到了这些意外的结果。我对可能收到的反馈意见很感兴趣。谢谢。

Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

    Dim wb As Workbook
    Dim BudWkb As Workbook
    Dim Wk2 As Worksheet
    Dim PNLWkb As Workbook
    Dim fpath As String
    Dim fname As String

    Set BudWkb = Workbooks("SubModel Forecast_Other Admin v4.xlsm")
    Set Wk2 = BudWkb.Sheets("By PM")

    fname = "Feb15 PNL"

    'fname = InputBox("Enter PNL File Name")
        Dim Wk4 As Worksheet
        Set Wk4 = BudWkb.Sheets("Validation")

        With Wk4
            Dim CCCol As Long
            Dim fRowCC As Long
            Dim lRowCC As Long
            CCCol = Wk4.Cells.Find("Cost Center", lookat:=xlWhole).Column
            fRowCC = Wk4.Cells.Find("Cost Center", lookat:=xlWhole).Offset(1, 0).row
            lRowCC = Wk4.Cells.Find("Cost Center", lookat:=xlWhole).End(xlDown).row
            Dim CCRg As Range
            Set CCRg = Wk4.Range(Wk4.Cells(fRowCC, CCCol), Wk4.Cells(lRowCC, CCCol))
            'MsgBox (CCRg.Address)

        End With



    Set PNLWkb = Workbooks("Feb15 PNL.xlsx")
    Dim Wk1 As Worksheet
    Set Wk1 = PNLWkb.Sheets("det")

    With Wk1

        If Left(Wk2.Name, 5) = "By PM" Then
            Dim OpsCol As Long
            OpsCol = Wk1.Cells.Find("Property Manager", lookat:=xlWhole).Column
        Else
            OpsCol = Wk1.Cells.Find("Submarket", lookat:=xlWhole).Column
        End If

        Dim FRow As Long
        Dim lRow As Long
        Dim ExpCol As Long
        Dim PropCodeCol As Long


        Dim Expense As String
        Expense = InputBox("Enter Expense GL")

        'to locate begining and ending row of data on PNL report
        'Identifies the column where the SubMarket names are located for lookup purposes
        'Defines the expense GL column to lookup based on the inputbox above
        FRow = Wk1.Cells.Find("66990000", lookat:=xlPart).Offset(2, 0).row
        lRow = Wk1.Cells.Find("66990000", lookat:=xlPart).End(xlDown).Offset(-1, 0).row
        ExpCol = Wk1.Cells.Find(Expense, lookat:=xlPart).Column
        PropCodeCol = Wk1.Cells.Find("Property Code", lookat:=xlWhole).Column


        'Defines the Range of the PM or Sub-Market Names
        Dim OpsRg As Range
        Set OpsRg = Wk1.Range(Wk1.Cells(FRow, OpsCol), Wk1.Cells(lRow, OpsCol))

        'Defines the Range of the Property Codes
        Dim PropCodeRg As Range
        Set PropCodeRg = Wk1.Range(Wk1.Cells(FRow, PropCodeCol), Wk1.Cells(lRow, PropCodeCol))

        'Defines the exact range of the expense column being analyzed
        Dim ExpRg As Range
        Set ExpRg = Wk1.Range(Wk1.Cells(FRow, ExpCol), Wk1.Cells(lRow, ExpCol))

    End With

            Dim AllEntRg As Range
            For Each Cell In OpsRg
              If Cell = "" Then
                  If AllEntRg Is Nothing Then
                      Set AllEntRg = Cells(Cell.row, PropCodeCol)
                  Else
                      Set AllEntRg = Union(AllEntRg, Cells(Cell.row, PropCodeCol))
                  End If
                'End If
              End If
            Next
            MsgBox (AllEntRg.Address)

            'MsgBox (Application.Match(Wk1.Cells(59, 1), CCRg, 0))
            'Dim y
            'y = Application.Match(Wk1.Cells(10, 1), CCRg, 0)
            'If IsError(y) Then
            'MsgBox ("pooopy error")
            'End If


            Dim EntityRg As Range
            'Dim c As Range
            For Each c In AllEntRg
            'Dim z
            'z = Application.Match(c, CCRg, 0)


                    If CCRg.Find(c.Value, lookat:=xlPart) Is Nothing Then
                        If EntityRg Is Nothing Then
                            Set EntityRg = c
                        Else
                            Set EntityRg = Union(EntityRg, c)
                        End If
                    End If
            Next
            MsgBox (EntityRg.Address)

            Dim CostCRg As Range
            Dim r As Range
            For Each r In AllEntRg

                    If Not CCRg.Find(r.Value, lookat:=xlPart) Is Nothing Then
                        If CostCRg Is Nothing Then
                            Set CostCRg = r
                        Else
                            Set CostCRg = Union(CostCRg, r)
                        End If
                    End If
            Next
            MsgBox (CostCRg.Address)

            Dim v As Double
            v = Application.WorksheetFunction.Sum(EntityRg)
            'SendKeys "{F9}"
            MsgBox (v)


Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True