范围变量不接受范围值

Question

我在这个项目上零星地工作了大约六个月。我终于遇到了一个我无法修复的错误。代码如下。 MaxIFS() modified from code at this link. 我还附上了两个屏幕截图，显示错误消息和引发错误的代码行。对于代码的粗略状态，我深表歉意。

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  

Answer 1

试试这个：

Set rMaxRange = Range("E2:E" & lastrow)
Set rLookup1 = Range("C2:C" & lastrow)

问候，