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

时间:2015-04-05 16:39:06

标签: excel vba excel-vba

我用我的代码一直在努力工作一天半。我有一个包含超过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

1 个答案:

答案 0 :(得分:1)

我无法运行您的代码,但我已经对其进行了审核并注意到了一些可能的问题。


lRowCC = Wk4.Cells.Find("Cost Center", lookat:=xlWhole).End(xlDown).row

`.End(xlDown)不是查找列最后一行的可靠方法。请阅读我的答案以获得解释:Excel vba – xlDown


你说:“对于EntityRg,定义的range.address与AllEntRg相同(不应该是这种情况)。”

你认为它们是相同的,因为EntityRg.Address = AllEntRg.Address

EntityRg .Address将是一串由逗号分隔的绝对单元格和范围地址。您可能不知道此字符串的最大长度约为255.我找不到任何文档,但根据我自己的实验,EntityRg .Address将被截断为小于256,这样就没有部分单元格或范围地址。

您是否被这些地址匹配的前255个字符所迷惑?

另一种可能性是CCRg.Find(c.Value, lookat:=xlPart)的每次使用都会返回Nothing,因此EntityRgAllEntRg是相同的。你说CostCRg给出错误;这是因为它是Nothing


您有两个循环在CCRg中搜索AllEntRg中的值。一个循环记录成功,一个记录失败。为什么不将循环组合成类似的东西:

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
Else
  If CostCRg Is Nothing Then
    Set CostCRg = r
  Else
    Set CostCRg = Union(CostCRg, r)
 End If
End If

我担心For Each c In AllEntRg没有给你你期望的东西。如果您将范围与Union组合在一起,它会将它们整理一下。所以Union(Range("A2"), Range("A3", Range("A5"), Range("A6"), Range("A7")).Address是 “$ A $ 2:$ A $ 3,$ A $ 5:$ A $ 7”不是“$ A $ 2,$ A $ 3,$ A $ 5,$ A $ 6,$ A $ 7”。我的回忆是For Each c In AllEntRg不会将“$ A $ 2:$ A $ 3”分成不同的单元格。

请使用 F8 逐步完成此循环,以检查它是否按预期执行。

希望这有帮助

回答评论中描述的问题

您的问题是您在使用With时不一致,特别是您没有确定要操作哪个工作簿。

Wk4明确指定为工作簿BufdWkbWk1指定为PNLWkb

然而,在

Set AllEntRg = Cells(Cell.row, PropCodeCol)

您没有为Cells指定工作表或工作簿。这相当于

Set AllEntRg = ActiveWorkbook.ActiveSheet.Cells(Cell.row, PropCodeCol)`

您需要编写Set AllEntRg = .Cells(Cell.row, PropCodeCol)(注意单元格之前的句点)并将此代码包含在With Wk1块中。