Excel错误424帮助需要

我不知道为什么Excel不喜欢这个代码,我已经通过了我所有的(虽然)有限的知识如何排除故障。

我的代码调用我在网上find的ProperUnion代码,它应该处理空范围和重复。 我只掌握了第二个代码如何工作的基本知识。 第一位是我的。

此代码根据是否标记项目来select项目列表,将每个标记保存为一个范围,然后根据需要将它们相交。 在这种情况下,我只testing“标志3”框被检查,这可能是什么原因造成的问题。 (所以rngx(1)rngx(2)rngx(4)+都是空值。)

我把'XXXXXX在正确的联盟,是给我debugging错误的线上。

任何和所有的帮助,不胜感激。

收集标记的信息代码

Sub GSFlagged(prg As String) 'prg is the Program Name Dim rng As Range Dim rngA As Range Dim rngx(1 To 8) As Variant Dim rngu As Range Dim r As Long Dim wsMaster As Worksheet Dim wsGenScore As Worksheet Dim wsScore As Worksheet Set wsMaster = Worksheets("Master List") Set wsGenScore = Worksheets("Generate Scorecard") Set wsScore = Worksheets("Scorecard") wsMaster.Activate 'Make sure that the master list is not filtered If wsMaster.AutoFilterMode = True Then wsMaster.AutoFilterMode = False End If 'Select all data in the Masterlist and then remove the headers Set rng = wsMaster.Range("B4:E4", Range("B4:E4").End(xlDown)) Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1) 'Filter by the program name wsMaster.Range("B4").AutoFilter Field:=2, Criteria1:=prg Set rngA = rng.SpecialCells(xlCellTypeVisible) 'Filter by flags with a loop over the variable r and save each set of visible cells as rngx(r) For r = 1 To 8 If wsGenScore.Shapes("Flag" & r).ControlFormat.Value = 1 Then wsMaster.Activate If wsMaster.AutoFilterMode = True Then wsMaster.AutoFilterMode = False End If wsMaster.Range("B4").AutoFilter Field:=r + 6, Criteria1:="<>" Set rngx(r) = rng.SpecialCells(xlCellTypeVisible) End If Next r 'After filtering through all the SKUs we union them using Proper Union a Custom VBA that allows for null values and removes duplicates. Set rngu = ProperUnion(rngx(1), rngx(2), rngx(3), rngx(4), rngx(5), rngx(6), rngx(7), rngx(8)) 'Now that we have rngu which is the union of all flagged SKUs we want to intersect that with the SKUs that are in the chosen program. Set rngi = Intersect(rngA, rngu) End Sub 

正确的联合代码来自: http : //www.cpearson.com/Excel/BetterUnion.aspx

  Function ProperUnion(ParamArray Ranges() As Variant) As Range '''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' ProperUnion ' This provides Union functionality without duplicating ' cells when ranges overlap. Requires the Union2 function. '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim ResR As Range Dim n As Long Dim r As Range If Not Ranges(LBound(Ranges)) Is Nothing Then 'xxxxxxxxxx Set ResR = Ranges(LBound(Ranges)) End If For n = LBound(Ranges) + 1 To UBound(Ranges) If Not Ranges(n) Is Nothing Then For Each r In Ranges(n).Cells If Application.Intersect(ResR, r) Is Nothing Then Set ResR = Union2(ResR, r) End If Next r End If Next n Set ProperUnion = ResR End Function 'Union2 is required for ProperUnion Function Union2(ParamArray Ranges() As Variant) As Range '''''''''''''''''''''''''''''''''''''''''''''''''''''''' ' Union2 ' A Union operation that accepts parameters that are Nothing. '''''''''''''''''''''''''''''''''''''''''''''''''''''''' Dim n As Long Dim RR As Range For n = LBound(Ranges) To UBound(Ranges) If IsObject(Ranges(n)) Then If Not Ranges(n) Is Nothing Then If TypeOf Ranges(n) Is Excel.Range Then If Not RR Is Nothing Then Set RR = Application.Union(RR, Ranges(n)) Else Set RR = Ranges(n) End If End If End If End If Next n Set Union2 = RR End Function 

你已经声明了rngx是一个Variant数组,但是它应该被声明为一个Range对象的数组。

所以把声明改为:

 Dim rngx(1 To 8) As Range 

正如目前所写, rngx的未分配元素正在被传递给ProperUnion ,其types为Variant/Empty ,这就是它崩溃的原因。 通过将rngx更改为Range ,参数将作为Variant/Range传递,未赋值的元素为Nothing