复杂的多选案例，variables声明，范围定义
我开发了我从头开始创build预算模板的代码。 目的是将实际GL数据信息自动填充到工作簿中的假设选项卡中。 我使用一个特定的月份作为testing。 为了确定一个合适的预测，我已经设置了假设选项卡，包含大约26个不同的地区办事处信息部分。
并不是所有的GL都被列出。 我已经将GL列入了一个特殊的费用（其他pipe理员）。 我有大约5个主要类别的支出，其余的总帐被视为“其他”。 由于类别的标题与GL帐户没有完全相同，所以我不得不在工作簿的单独标签上创build地图网格，以便将类别名称与不同的GL链接起来。
最终目标是：
- 在每个PM区域办公室的假设选项卡上循环select每个类别types，
- 计算PM办公室每笔支出的总金额（例如，驱逐）加上其在另一工作簿中的成本中心，
- 计算来自同一其他工作簿的仅实体代码的每个支出的总金额。
下面的代码只循环并计算驱逐GL的花费。 我正在寻求改进性能改进的代码，更容易的将来维护（灵活性）和效率。 最终目标是循环使用不同types的支出。 现在，我的解决scheme是重复variables/范围声明，用EvictionRg替代下一个开销，并添加另一个案例 。
我担心代码会变得太长，性能可能会受到影响。 任何洞察力和指导，如何我可以计划，修改代码等，以帮助我这样做将不胜感激。 我已经三天了，试图通过绘制stream程图和其他方法来帮助我进行头脑风暴和阅读其他文章。 恐怕我在VBA知识的末尾。
Sub Try() 'Application.Calculation = xlCalculationManual Application.ScreenUpdating = False Dim Wb1 As Workbook Dim Wb2 As Workbook Set Wb1 = Workbooks("SubModel Forecast_Other Admin v4.xlsm") Set Wb2 = Workbooks("Feb15 PNL.xlsx") Dim Wk4 As Worksheet Set Wk4 = Wb1.Sheets("ASSUMPTIONS") Dim Wk5 As Worksheet Set Wk5 = Wb1.Sheets("Validation") Dim Wk7 As Worksheet Set Wk7 = Wb1.Sheets("GL Mapping") Dim Wk1 As Worksheet Set Wk1 = Wb2.Sheets("det") Dim fname As String fname = "Feb15 PNL" With Wb1 '----submodel With Wk5 '---validation tab Dim CCCol As Long Dim fRowCC As Long Dim lRowCC As Long CCCol = Wk5.Cells.Find("Cost Center", lookat:=xlWhole).Column fRowCC = Wk5.Cells.Find("Cost Center", lookat:=xlWhole).Offset(1, 0).row lRowCC = Wk5.Cells.Find("Cost Center", lookat:=xlWhole).End(xlDown).row '---Determine cost center code column range and it's corresponding Region Office Name(ClinkRg) Dim CCRg As Range Set CCRg = Wk5.Range(Wk5.Cells(fRowCC, CCCol), Wk5.Cells(lRowCC, CCCol)) Dim CLinkRg As Range Set CLinkRg = Wk5.Range(Wk5.Cells(fRowCC, CCCol).Offset(0, -1), Wk5.Cells(lRowCC, CCCol).Offset(0, -1)) End With '----closes W5 Validation tab '----Grid that contains GL accounts and their category type With Wk7 Dim MapGLCol As Long MapGLCol = Wk7.Cells.Find("GL", lookat:=xlWhole).Column Dim MapfRow As Long MapfRow = Wk7.Cells.Find("GL", lookat:=xlWhole).Offset(1, 0).row Dim MaplRow As Long MaplRow = Wk7.Cells(rows.Count, MapGLCol).End(xlUp).row Dim MapGLRg As Range Set MapGLRg = Wk7.Range(Wk7.Cells(MapfRow, MapGLCol), Wk7.Cells(MapfRow, MapGLCol)) Dim TypeRg As Range Set TypeRg = Wk7.Range(Wk7.Cells(MapfRow, MapGLCol).Offset(0, -1), Wk7.Cells(MaplRow, MapGLCol).Offset(0, -1)) End With '--closes wk7 - GL Mapping End With '--closes Wb1 - SubModel file '---------PNL wkb With Wb2 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 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)) 'Defining range for GLs under Other Admin Dim GLRow As Long Dim BegGLCol As Long Dim EndGLCol As Long GLRow = Wk1.Cells.Find("66550000", lookat:=xlPart).row BegGLCol = Wk1.Cells.Find("66550000", lookat:=xlPart).Column EndGLCol = Wk1.Cells.Find("66990000", lookat:=xlPart).Column Dim GLRg As Range Set GLRg = Wk1.Range(Wk1.Cells(GLRow, BegGLCol), Wk1.Cells(GLRow, EndGLCol)) '----Find All GL accounts in WB1 Wk5 Validation Tab range TypeRg categorized as Evictions($) '----Then Look up each GL account in the row with all the GLs in the current workbook PNL and Wk1 '----------Set that up as TempCell '----------Set the range for the entire column of data for each GL and consolidate as one range 'EvictionRg' '----------Purpose of this is to set up one range for all GL accounts categorized as Eviction GL accoutns Dim c As Range For Each c In TypeRg If c = "Evictions ($)" Then Dim TempCell As Range Set TempCell = GLRg.Find(c.Offset(0, 1).Value, lookat:=xlWhole) 'MsgBox (TempCell) Dim EvictionRg As Range If EvictionRg Is Nothing Then Set EvictionRg = Wk1.Range(Wk1.Cells(FRow, TempCell.Column), Wk1.Cells(LRow, TempCell.Column)) Else Set EvictionRg = Union(EvictionRg, Wk1.Range(Wk1.Cells(FRow, TempCell.Column), Wk1.Cells(LRow, TempCell.Column))) End If End If Next c '---Sum up all the amounts under all the GL eviction accounts and set them as "z" Dim z As Double z = Application.WorksheetFunction.Sum(EvictionRg) '---Define Ranges for All Entities, Cost Centers, Entities Not Cost Centers 'Define the range on the Property PNL workbook all items booked under an entity Dim AllEntRg As Range Dim cell As Range For Each cell In OpsRg If cell = "" Then If AllEntRg Is Nothing Then Set AllEntRg = Wk1.Cells(cell.row, PropCodeCol) Else Set AllEntRg = Union(AllEntRg, Wk1.Cells(cell.row, PropCodeCol)) End If End If Next cell 'Define the range of the property PNL workbook that are Entity codes that are NOT Cost Center Codes '---Entity Codes and Cost Center Codes are within the AllEntRg '---Create a new range in the Eviction GL Range that intersects '---------the rows of the entity only codes and the eviction GL columns With AllEntRg Dim EntityRg As Range Dim cl As Range For Each cl In AllEntRg If CCRg.Find(cl.Value, lookat:=xlWhole) Is Nothing Then Dim cl2 As Range For Each cl2 In EvictionRg '------extra If cl2.row = cl.row Then '------extra If EntityRg Is Nothing Then Set EntityRg = cl2 Else Set EntityRg = Union(EntityRg, cl2) End If End If Next cl2 End If Next cl 'MsgBox (EntityRg.Address) Dim v As Double v = Application.WorksheetFunction.Sum(EntityRg) End With 'With AllEntRg 'Dim CostCRg As Range 'Dim r As Range 'For Each r In AllEntRg ' If Not CCRg.Find(r.Value, lookat:=xlWhole) Is Nothing Then ' Dim cl3 As Range ' For Each cl3 In EvictionRg ' If cl3.row = r.row Then ' If CostCRg Is Nothing Then ' Set CostCRg = cl3 ' Else ' Set CostCRg = Union(CostCRg, cl3) ' End If ' End If ' Next cl3 ' End If 'Next r 'End With 'MsgBox (CostCRg.Address) 'Define cell ranges for regional PM offices that contain more than one cost center ocde With AllEntRg If Not AllEntRg.Find("cahied", lookat:=xlWhole) Is Nothing Then Dim n As Range Set n = AllEntRg.Find("cahied", lookat:=xlWhole) End If 'MsgBox (n.Address) If Not AllEntRg.Find("cahrvr", lookat:=xlWhole) Is Nothing Then Dim n2 As Range Set n2 = AllEntRg.Find("cahrvr", lookat:=xlWhole) 'MsgBox (n2.Address) End If If Not AllEntRg.Find("atlnw", lookat:=xlWhole) Is Nothing Then Dim an1 As Range Set an1 = AllEntRg.Find("atlnw", lookat:=xlWhole) 'MsgBox (an1.Address) End If If Not AllEntRg.Find("atln", lookat:=xlWhole) Is Nothing Then Dim an2 As Range Set an2 = AllEntRg.Find("atln", lookat:=xlWhole) 'MsgBox (an2.Address) End If If Not AllEntRg.Find("atlse", lookat:=xlWhole) Is Nothing Then Dim ae1 As Range Set ae1 = AllEntRg.Find("atlse", lookat:=xlWhole) 'MsgBox (ae1.Address) End If If Not AllEntRg.Find("atle", lookat:=xlWhole) Is Nothing Then Dim ae2 As Range Set ae2 = AllEntRg.Find("atle", lookat:=xlWhole) 'MsgBox (ae2.Address) End If If Not AllEntRg.Find("atlsw", lookat:=xlWhole) Is Nothing Then Dim as1 As Range Set as1 = AllEntRg.Find("atlsw", lookat:=xlWhole) 'MsgBox (as1.Address) End If If Not AllEntRg.Find("atls", lookat:=xlWhole) Is Nothing Then Dim as2 As Range Set as2 = AllEntRg.Find("atls", lookat:=xlWhole) 'MsgBox (as2.Address) End If End With '---Create a new range in the Eviction GL Range that intersects '---------the rows of the specific cost center codes and the eviction GL columns If Not n Is Nothing Or Not n2 Is Nothing Then Dim n3 As Range For Each n3 In EvictionRg If n3.row = n.row Or n3.row = n2.row Then Dim InlandRg As Range If InlandRg Is Nothing Then Set InlandRg = n3 Else Set InlandRg = Union(InlandRg, n3) End If End If Next n3 End If Dim n3v As Double n3v = Application.WorksheetFunction.Sum(InlandRg) If Not an1 Is Nothing Or Not an2 Is Nothing Then Dim an3 As Range For Each an3 In EvictionRg If an3.row = an1.row Or an3.row = an2.row Then Dim ATLNrg As Range If ATLNrg Is Nothing Then Set ATLNrg = an3 Else Set ATLNrg = Union(ATLNrg, an3) End If End If Next an3 End If Dim an3v As Double an3v = Application.WorksheetFunction.Sum(ATLNrg) If Not ae1 Is Nothing Or Not ae2 Is Nothing Then Dim ae3 As Range For Each ae3 In EvictionRg If ae3.row = ae1.row Or ae3.row = ae2.row Then Dim ATLErg As Range If ATLErg Is Nothing Then Set ATLErg = ae3 Else Set ATLErg = Union(ATLErg, ae3) End If End If Next ae3 End If Dim ae3v As Double ae3v = Application.WorksheetFunction.Sum(ATLErg) If Not as1 Is Nothing Or Not as2 Is Nothing Then Dim as3 As Range For Each as3 In EvictionRg If as3.row = as1.row Or as3.row = as2.row Then Dim ATLSrg As Range If ATLSrg Is Nothing Then Set ATLSrg = as3 Else Set ATLSrg = Union(ATLSrg, as3) End If End If Next as3 End If Dim as3v As Double as3v = Application.WorksheetFunction.Sum(ATLSrg) End With '---closes Wk1 (PNL report) End With '--closes wb2 ''--------Cycle through the different PM regional office section (column) in assumptions tab '---------Identify where Evictions ($) is located '---------calculate total eviction GL amounts for each section (by Entity code only, by PM + cost center code) With Wb1 With Wk4 Wk4.Outline.ShowLevels RowLevels:=2 Dim dateRow As Long dateRow = Wk4.Cells.Find("ACT", lookat:=xlWhole).Offset(1, 0).row Dim fRow2 As Long Dim AssumCol As Long Dim lRow2 As Long fRow2 = Wk4.Cells.Find("Global Assumptions", lookat:=xlWhole).row AssumCol = Wk4.Cells.Find("Global Assumptions", lookat:=xlWhole).Column lRow2 = Wk4.Cells(rows.Count, AssumCol).End(xlUp).row Dim AssumptionRg As Range Set AssumptionRg = Wk4.Range(Wk4.Cells(fRow2, AssumCol), Wk4.Cells(lRow2, AssumCol)) Dim r2 As Range Dim isItem As Boolean For Each r2 In AssumptionRg Select Case r2 Case "Evictions ($)" isItem = True Dim PM As Range Set PM = r2.End(xlUp) '---If PM Label is Entity Level, Inland Empire or is one of the Atlanta PMs then '-----IF Entity Level, the sum up the Entity Range for the Evictions '-----IF Inland Empire, sum up Inland Empire properties and Inland Empire Cost Center entries '-----IF Atlanta, the sum up Atlanta PMs and their cost center entries individually If PM = "Tie-Out To Actuals" Or PM = "Entity Level Assumptions" _ Or PM = "Inland Empire" Or PM = "Atlanta East" _ Or PM = "Atlanta North" Or PM = "Atlanta South" Then If PM = "Tie-Out To Actuals" Then Wk4.Cells(r2.row, 4) = z End If If PM = "Entity Level Assumptions" Then Wk4.Cells(r2.row, 4) = v End If If PM = "Inland Empire" Then Wk4.Cells(r2.row, 4).Formula = _ "=SUMPRODUCT(('[" & fname & ".xlsx]det'!" & OpsRg.Address & "=" & PM.Address & ")*'[" & fname & ".xlsx]det'!" & EvictionRg.Address & ")" _ & "+" & n3v Wk4.Cells(r2.row, 4).Value = Wk4.Cells(r2.row, 4).Value End If If PM = "Atlanta East" Then Wk4.Cells(r2.row, 4).Formula = _ "=SUMPRODUCT(('[" & fname & ".xlsx]det'!" & OpsRg.Address & "=" & PM.Address & ")*'[" & fname & ".xlsx]det'!" & EvictionRg.Address & ")" _ & "+" & ae3v End If If PM = "Atlanta North" Then Wk4.Cells(r2.row, 4).Formula = _ "=SUMPRODUCT(('[" & fname & ".xlsx]det'!" & OpsRg.Address & "=" & PM.Address & ")*'[" & fname & ".xlsx]det'!" & EvictionRg.Address & ")" _ & "+" & an3v End If If PM = "Atlanta South" Then Wk4.Cells(r2.row, 4).Formula = _ "=SUMPRODUCT(('[" & fname & ".xlsx]det'!" & OpsRg.Address & "=" & PM.Address & ")*'[" & fname & ".xlsx]det'!" & EvictionRg.Address & ")" _ & "+" & as3v End If Else Dim CCCodeRow As Long Dim CCCodeCol As Long CCCodeRow = CLinkRg.Find(PM.Value, lookat:=xlWhole).Offset(0, 1).row CCCodeCol = CLinkRg.Find(PM.Value, lookat:=xlWhole).Offset(0, 1).Column If Wk5.Cells(CCCodeRow, CCCodeCol).Value = "None" Then Wk4.Cells(r2.row, 4).Formula = _ "=SUMPRODUCT(('[" & fname & ".xlsx]det'!" & OpsRg.Address & "=" & PM.Address & ")*'[" & fname & ".xlsx]det'!" & EvictionRg.Address & ")" Else Wk4.Cells(r2.row, 4).Formula = _ "=SUMPRODUCT(('[" & fname & ".xlsx]det'!" & OpsRg.Address & "=" & PM.Address & ")*'[" & fname & ".xlsx]det'!" & EvictionRg.Address & ")" _ & "+SUMPRODUCT(('[" & fname & ".xlsx]det'!" & PropCodeRg.Address & "=" & "Validation!" & Wk5.Cells(CCCodeRow, CCCodeCol).Address & ")*'[" & fname & ".xlsx]det'!" & EvictionRg.Address & ")" End If End If End Select Next r2 Set r2 = Nothing Set Wk4 = Nothing End With '---closes assumptions tab End With '---workbook2 'Application.Calculation = xlCalculationAutomatic Application.ScreenUpdating = True 噢，那是相当的阅读！ 虽然我同意共同国际，但我确实看到一个非常简单的解决scheme来修剪代码，并使其更容易维护。
整个事情我看不到一个单一的function。 如果你编写的脚本很长，而不是使用它们，你需要开始…他们会改变你的生活。
让我们看一个简单的块，我看到重复几次（8）次。 请注意，我看到几个更大的块在整个过程中重复，但这一个将很容易学习。
If Not AllEntRg.Find("atlsw", lookat:=xlWhole) Is Nothing Then Dim as1 As Range Set as1 = AllEntRg.Find("atlsw", lookat:=xlWhole) End If
我只看到三件事从if变为if如果在这部分代码中，input端的2是一个范围和一个string，如果条件满足，它会输出一个范围。 所以你写这样的函数，并把它放在同一工作簿中的任何模块的某个地方。
Public Function DefMultiCCPMRange(rngSearchRange as range, strSearchString as string)as range If Not AllEndRg.Find(strSearchString, lookat:=xlWhole) Is Nothing Then set DefMultiCCPMRange = rngSearchRange.Find(strSearchString, Lookat:=xlWhole) End If End Function
现在，而不是一遍又一遍地重写。
If Not AllEntRg.Find("atlsw", lookat:=xlWhole) Is Nothing Then Dim as1 As Range Set as1 = AllEntRg.Find("atlsw", lookat:=xlWhole) End If
你一遍又一遍地写这个。
Dim as1 as Range set as1 = DefMultiCCPMRange(AllEndRg,"atlsw")
此外，函数中使用的variables的生命周期在函数结束时结束，因此，在整个运行时间内，不会存储您在内存中使用的每个variables。
如果你玩的话，这应该会让你感觉很不舒服。
我也将看看数组，集合和词典项目。 一旦你看到他们的权力真的在哪里，他们就会改变你的生活。 你可以变得有创意，而不是声明和设置这个范围8次，你可以做一个for循环，并把它们放在一个名为CC代码的对象中。
Dim arrCCCodes(3) as string 'change to arrCCCodes(7) for your 8 codes arrCCCodes(0) = "cahied" arrCCCodes(1) = "cahrvr" arrCCCodes(2) = "atlnw" arrCCCodes(3) = "atln" 'etc... 'add a reference to Microsoft scripting runtime Dim odicCCRanges as New Dictionary For i = 0 to UBound(arrCCCodes) odicCCRanges.Add arrCCCodes(i), DefMultiCCPMRange(AllEndRg, arrCCCodes(i)) next
这会给你一个有4个范围的字典对象（在你的实际代码中是8），更不用说失去几页代码了。 您可以调用odicCCRanges("cahied").Item(1)或odicCCRanges(arrCCCodes(0)).Item(1) 。 这是它增加你的项目生命周期的地方。 如果你需要添加一个新的CC，你只需要改变arrCCCodes声明来包含一个以上的项目，然后在下面添加它，剩下的代码就会自动将其选中，运行define ranges函数并将其添加到字典。
你的代码看起来并不是那么糟糕，你对空值的testing，并宣布你的变数，所有的好东西。 这只是所有系列脚本。 尝试单步执行代码，并观察VBA IDE中的本地窗口。 特别是在设定后扩大范围节点。 它会打击你的想法实际上在一个范围对象。
你显然有很多时间在这方面投入，但是我真的认为你已经完成了复杂的事情。 因为你所有的代码正在做的是构build范围，然后总结他们我想你可以做到这一点与数组公式。