Excel VBA问题求助：Range类型变量无法接受区域赋值报错

断断续续开发该项目已有约六个月时间，目前遇到一个无法修复的bug，相关代码如下。其中MaxIF()函数修改自公开的VBA自定义MaxIFS实现代码。附上展示报错信息和触发错误代码行的截图，暂请谅解代码尚未完成优化。

Option Explicit

Sub CountSeats()

  Dim lNoSeats, lG2, lastrow, lStateRow, lStateSeats, lStateNo As Long
  Dim sFileName, sPathName, sFunction, sStateAbbr As String
  Dim wsSource, wsTarget As Worksheet
  Dim rMaxRange, rLookup1 As Range
  Dim vVar_Range1 As Variant
  Set wsSource = ThisWorkbook.Worksheets("Priority Values calculated")
  Dim wbSource, wbTarget As Workbooks
  lNoSeats = wsSource.Range("G2").Value
  'Gotta get the slash going in the right direction for Mac/Windows
  #If Mac Then
      sPathName = ThisWorkbook.Path & " / "
    #Else
      sPathName = ThisWorkbook.Path & "\"
  #End If
  wsSource.Copy

  sFileName = sPathName & lNoSeats & " seats for apportionment.xlsm"
  If Len(Dir(sFileName)) > 0 Then
     ' First remove readonly attribute, if set
     SetAttr sFileName, vbNormal
     ' Then delete the file
     Kill sFileName
  End If
  Set wsTarget = ThisWorkbook.Worksheets("Priority Values calculated")
  'ActiveWorkbook.SaveAs FileName:=sPathName & lNoSeats & " seats for apportionment.xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled

  lNoSeats = wsTarget.Range("G2").Value
  'Copy and paste G2 to replace formula with value
  wsTarget.Range("G2").Copy
  wsTarget.Range("G2").PasteSpecial (xlPasteValues)
  lastrow = wsTarget.Cells(Rows.Count, 6).End(xlUp).Row
  'ActiveWorkbook.Save

  With wsTarget
    rMaxRange = "E2:E" & lastrow
    rLookup1 = "C2:C" & lastrow
  End With

  For lStateNo = 2 To 51

     'sStateAbbr = wsTarget.Range("C" & lStateNo)
     sStateAbbr = "CA"
     lStateSeats = MaxIF((rMaxRange), (rLookup1), sStateAbbr)
     wsTarget.Range("H" & lastrow) = lStateSeats

  Next lStateNo

End Sub

Function MaxIF(rMaxRange As Range, rLookup1 As Range, vVar_Range1 As Variant) As Variant

    Dim vLU1 As Variant
    Dim lfounds As Long
    Dim rcell As Range

    vLU1 = rLookup1.Value2 '<--| store Lookup_Range1 values

    ReDim lValuesForMax(1 To rMaxRange.Rows.Count) As Long '<--| initialize lValuesForMax to its maximum possible size
    For Each rcell In rMaxRange.Columns(1).SpecialCells(xlCellTypeConstants, xlNumbers)
        If vLU1(rcell.Row, 1) = vVar_Range1 Then '<--| check 'rLookup1' value in corresponding row of current 'MaxRange' cell
                lfounds = lfounds + 1
                lValuesForMax(lfounds) = CLng(rcell) '<--| store current 'rMaxRange' cell
        End If
    Next rcell
    ReDim Preserve lValuesForMax(1 To lfounds) '<--| resize ValuesForMax to its actual values number
    MaxIF = Application.Max(lValuesForMax)
End Function

核心报错原因 #

• 对Range类型的对象赋值时遗漏Set关键字：VBA中对象赋值必须使用Set，你代码中rMaxRange = "E2:E" & lastrow、rLookup1 = "C2:C" & lastrow这两行没有加Set，会默认读取Range的Value属性赋值给变量，和你声明的Range类型不匹配，直接触发类型错误。
• 调用MaxIF时参数外围加了多余括号：MaxIF((rMaxRange), (rLookup1), sStateAbbr)这种写法会强制将Range对象转换为值数组，传入要求Range类型的形参时也会触发类型错误。

其他可优化问题 #

• 一行声明多个变量时需逐个指定类型，否则未指定类型的变量会被默认声明为Variant，例如原代码Dim lNoSeats, lG2, lastrow, lStateRow, lStateSeats, lStateNo As Long中，只有lStateNo是Long类型，其余均为Variant。
• 声明的wbSource、wbTarget变量类型错误（单个工作簿应为Workbook类型），且代码中未实际使用，属于冗余代码可删除。

修复后核心代码片段 #

' 修复Range对象赋值
With wsTarget
  Set rMaxRange = .Range("E2:E" & lastrow)
  Set rLookup1 = .Range("C2:C" & lastrow)
End With

' 修复函数调用的多余括号
lStateSeats = MaxIF(rMaxRange, rLookup1, sStateAbbr)

内容的提问来源于stack exchange，提问作者Tony Lima