vba - 数组上的运行时错误 91

Question

我在几个变量上收到运行时错误 91，我真的不知道我做错了什么......

变量为:IQRngRef、tempRng、unionVariable

我认为它有一些东西，除了 unionVariable 之外，它们都是数组(至少不应该是)。

请问我可以在这里寻求帮助吗？

    Option Explicit

    Private Sub averageScoreRelay()
        ' 1. Run from PPT and open an Excel file
        ' 2. Start at slide 1 and find a box that contains the words "iq_", if it has those words then it will have numbers after it like so "iq_43" or "iq_43, iq_56,iq_72".
        ' 3. find those words and numbers in the opened Excel file after splitting and re-formating string.
        ' 3. Copy column into a new sheets and repeat for all "iq_'s" until sheets 2 has a table.
        ' 4. Copy table from xl Paste Table into ppt
        ' 5. Do this for every slide

        'Timer start
        Dim StartTime As Double
        Dim SecondsElapsed As Double
        StartTime = Timer


        'Create variables
        Dim xlApp As Excel.Application
        Dim xlWB As Excel.Workbook
        Dim ShRef As Excel.Worksheet
        Dim pptPres As Object
        Dim colNumb As Long
        Dim rowNumb As Long

        ' Create new excel instance and open relevant workbook
        Set xlApp = New Excel.Application
        'xlApp.Visible = True 'Make Excel visible
        Set xlWB = xlApp.Workbooks.Open("C:\Users\Pinlop\Desktop\Gate\Macros\averageScores\pptxlpratice\dummy2.xlsx", True, False, , , , True, Notify:=False) 'Open relevant workbook
        If xlWB Is Nothing Then                      ' may not need this if statement. check later.
            MsgBox ("Error retrieving Average Score Report, Check file path")
            Exit Sub
        End If
        xlApp.DisplayAlerts = False

        'Find # of iq's in workbook
        Set ShRef = xlWB.Worksheets("Sheet1")
        colNumb = ShRef.Cells(1, ShRef.Columns.Count).End(xlToLeft).Column
        rowNumb = ShRef.Cells(ShRef.Rows.Count, 1).End(xlUp).Row

        Dim IQRef() As String
        Dim iCol As Long
        Dim IQRngRef() As Range

        ReDim IQRef(colNumb)
        ReDim IQRngRef(colNumb)

        ' capture IQ refs locally
        For iCol = 2 To colNumb
            IQRngRef(iCol) = ShRef.Range(ShRef.Cells(1, iCol), ShRef.Cells(rowNumb, iCol)).Value
            IQRef(iCol) = ShRef.Cells(1, iCol).Value
        Next iCol

        'Make pptPres the ppt active
        Set pptPres = PowerPoint.ActivePresentation

        'Create variables for the slide loop
        Dim pptSlide As Slide
        Dim Shpe As Shape
        Dim pptText As String
        Dim iq_Array As Variant
        Dim arrayLoop As Long
        Dim myShape As Object
        Dim outCol As Long
        Dim i As Long
        Dim lRows As Long
        Dim lCols As Long
        Dim k As Long

        'Loop through each pptSlide and check for IQ text box, grab avgScore values and create pptTable
        For Each pptSlide In pptPres.Slides

            i = 0
            pptSlide.Select

            'searches through shapes in the slide
            For Each Shpe In pptSlide.Shapes

                If Not Shpe.HasTextFrame Then GoTo nextShpe 'boom, one less nested If statement
                If Not Shpe.TextFrame.HasText Then GoTo nextShpe ' boom, another nested If statement bites the dust

                outCol = 0

                'Set pptText as the Text in the box, then make it lowercase and trim Spaces and Enters
                pptText = Shpe.TextFrame.TextRange
                pptText = LCase(Replace(pptText, " ", vbNullString))
                pptText = Replace(Replace(Replace(pptText, vbCrLf, vbNullString), vbCr, vbNullString), vbLf, vbNullString)


                'Identify if within text there is "iq_"
                If InStr(1, pptText, "iq_") <= 0 Then GoTo nextShpe

                'set iq_Array as an array of the split iq's
                iq_Array = Split(pptText, ",")

                Dim hasIQs As Boolean
                Dim checkStr As String
                Dim pCol As Long
                Dim checkOne

                checkOne = iq_Array(0)

                hasIQs = Left(checkOne, 3) = "iq_"

                Dim tempRng() As Range

                If hasIQs Then
                    ' paste inital column into temporary worksheet
                    tempRng(0) = ShRef.Columns(1)
                End If

                ' loop for each iq_ in the array
                For arrayLoop = LBound(iq_Array) To UBound(iq_Array)
                    ' Take copy of potential ref and adjust to standard if required
                    checkStr = iq_Array(arrayLoop)
                    If hasIQs And Left(checkStr, 3) <> "iq_" Then checkStr = "iq_" & checkStr

                    ' Look for existence of corresponding column in local copy array
                    pCol = 0
                    For iCol = 2 To colNumb
                        If checkStr = IQRef(iCol) Then
                            pCol = iCol
                            Exit For
                        End If
                    Next iCol

                    If pCol > 0 Then
                        ' Paste the corresponding column into the forming table
                        outCol = outCol + 1
                        tempRng(outCol) = ShRef.Columns(pCol)
                    End If

                Next arrayLoop

                If outCol > 1 Then                   'data was added
                    ' Copy table

                    Dim unionVariable As Range

                    unionVariable = tempRng(0)


                    For k = 1 To i
                        unionVariable = Union(unionVariable, tempRng(k))
                    Next k

                    unionVariable.Copy               ' all the data added to ShWork

tryAgain:

                    ActiveWindow.ViewType = ppViewNormal
                    ActiveWindow.Panes(2).Activate

                    Set myShape = pptSlide.Shapes.PasteSpecial(DataType:=ppPasteHTML, Link:=msoFalse)

                    On Error GoTo tryAgain
                    On Error GoTo clrSht

                    'Set position:
                    myShape.Left = -200
                    myShape.Top = 150 + i
                    i = i + 150

                End If

clrSht:

                'Clear Sheet2 for next slide
                Erase tempRng()

nextShpe:

            Next Shpe

nextSlide:

        Next pptSlide

        xlWB.Close
        xlApp.Quit

        xlApp.DisplayAlerts = True

        'End Timer
        SecondsElapsed = Round(Timer - StartTime, 2)
        MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation

    End Sub

Answer 1

Dim something() As String

这声明了一个动态大小的数组，其中每个项目都是一个String。调整大小后，您可以执行以下操作(假设 i 在数组的边界内):

something(i) = "foo"

现在这个:

Dim something() As Range

这声明了一个动态大小的数组，其中每个项目都是一个Range。调整大小后，您可以执行以下操作(假设 i 在数组的边界内):

Set something(i) = Range("A1")

请注意 Set 关键字 - 在 VBA 中，每当您分配对象引用时，它都是必需的。 Range 是一个对象，您需要使用 Set 关键字来进行该赋值。

在您的代码中:

tempRng(0) = ShRef.Columns(1)

这确实是一个 Range，但缺少 Set 关键字。这将抛出你得到的 RTE91。

这里也一样:

unionVariable = tempRng(0)

如果没有 Set 关键字，则无法分配对象引用。

这里:

IQRngRef(iCol) = ShRef.Range(ShRef.Cells(1, iCol), ShRef.Cells(rowNumb, iCol)).Value

这不是一个范围。它是 Range 的 .Value，并且是 Variant - 而不是对象，因此添加 Set 关键字不会解决任何问题。如果您的意思是 IQRngRef 保存 Range 对象，则需要执行以下操作:

Set IQRngRef(iCol) = ShRef.Range(ShRef.Cells(1, iCol), ShRef.Cells(rowNumb, iCol))