VBA运行时错误“ 424”。所需对象。不确定出什么问题了吗?

时间:2019-07-29 14:40:29

标签: vba

尝试在excel中运行以下vba脚本代码时,我收到运行时错误“ 424”对象。

该错误发生在代码行:

For x = 0 To Rs.Fields.Count - 1

我不知道为什么会这样。这是从其他人那里发送给我的代码,不再使用SQL作为数据源,而只是引用已经粘贴到“组合数据”表中的数据。

Sub getInfo()


    Dim sProvider As String
    Dim strSQL As String
    Dim JanRange, FebRange, MarRange, AprRange, MayRange, JunRange, TargetRange As Range
    Dim JulRange, AugRange, SepRange, OctRange, NovRange, DecRange, SumRange As Range
    Dim Sht As Worksheet
    Dim newSht As Worksheet
    Dim comSht As Worksheet
    Dim x As Integer
    Dim LastMonthYear As Integer
    Dim comLastRow As Integer


    Application.DisplayAlerts = False

    Set Sht = ThisWorkbook.Sheets("Over View")
    Set comSht = ThisWorkbook.Sheets("Combined Data")

    Set JanRange = Sht.Range("A2:B17")
    Set FebRange = Sht.Range("E2:F17")
    Set MarRange = Sht.Range("A20:B35")
    Set AprRange = Sht.Range("E20:F35")
    Set MayRange = Sht.Range("A37:B52")
    Set JunRange = Sht.Range("E37:F52")
    Set JulRange = Sht.Range("A54:B69")
    Set AugRange = Sht.Range("E54:F69")
    Set SepRange = Sht.Range("A71:B86")
    Set OctRange = Sht.Range("E71:F86")
    Set NovRange = Sht.Range("A88:B103")
    Set DecRange = Sht.Range("E88:F103")
    Set SumRange = Sht.Range("I2:J17")

    'Setting Year equal to year of last month
    If Month(Date) = 1 Then
        LastMonthYear = Year(Date) - 1
    Else
        LastMonthYear = Year(Date)
    End If

    'Adding a new sheet after the first sheet
    Set newSht = ThisWorkbook.Worksheets.Add
    newSht.Move after:=Worksheets("Over View")
    newSht.Name = MonthName(Month(DateAdd("m", -1, Date))) & " " & LastMonthYear & " Data"

    'Get the column names from the recordset to put at the top of the spreadsheet
    For x = 0 To Rs.Fields.Count - 1
        newSht.Cells(1, x + 1).Value = Rs.Fields(x).Name
    Next

    'Copying the recordset to the new sheet, then deleting some unneccessary columns, formatting columns, etc
    With newSht
        .Range("A2").CopyFromRecordset Rs
        .Columns("AP").Delete
        .Columns("O:R").Delete
        .Columns("B").Delete
        .Columns("D:G").NumberFormat = "M/D/YYYY"
        .Columns("L:M").NumberFormat = "#,##0"
        .Columns("N:AG").NumberFormat = "#,##0.00"
        .Rows(1).Font.Bold = True
        .UsedRange.Columns.AutoFit

        'Getting the last row of the combined sheet and then pasting the new information to the combined sheet
        comLastRow = comSht.UsedRange.Rows.Count
        .Range("A2:AJ" & .UsedRange.Rows.Count).Copy comSht.Range("A" & comLastRow + 1)
    End With
    Rs.Close
    cn.Close


    'Calculating Combined Numbers on Main Sheet
    Sht.Range("J3").Formula = "=COUNTA('Combined Data'!$B:$B)-1"
    Sht.Range("J4").Formula = "=SUM('Combined Data'!$O:$O) / SUM('Combined Data'!$L:$L)"
    Sht.Range("J5").Formula = "=SUM('Combined Data'!$P:$P) / SUM('Combined Data'!$L:$L)"
    Sht.Range("J6").Formula = "=SUM('Combined Data'!$R:$R) / SUM('Combined Data'!$L:$L)"
    Sht.Range("J7").Formula = "=SUM('Combined Data'!$N:$N) / SUM('Combined Data'!$L:$L)"
    Sht.Range("J8").Formula = "=SUM('Combined Data'!$O:$O) / J3"
    Sht.Range("J9").Formula = "=SUM('Combined Data'!$P:$P) / J3"
    Sht.Range("J10").Formula = "=SUM('Combined Data'!$R:$R) / J3"
    Sht.Range("J11").Formula = "=J12/J3"
    Sht.Range("J12").Formula = "=SUM('Combined Data'!$N:$N)"
    Sht.Range("J13").Formula = "=SUM('Combined Data'!$N:$N) / SUM('Combined Data'!$M:$M)"
    Sht.Range("J14").Formula = "=SUM('Combined Data'!$M:$M) / J3"
    Sht.Range("J15").Formula = "=SUM('Combined Data'!$L:$L) / J3"
    Sht.Range("J16").Formula = "=SUM('Combined Data'!$AJ:$AJ)"
    Sht.Range("J17").Formula = "=J16/J3"


    'Selecting the range for the new month based on what month last month was
    Select Case Month(DateAdd("m", -1, Date))
        Case 1
            Set TargetRange = JanRange
        Case 2
            Set TargetRange = FebRange
        Case 3
            Set TargetRange = MarRange
        Case 4
            Set TargetRange = AprRange
        Case 5
            Set TargetRange = MayRange
        Case 6
            Set TargetRange = JunRange
        Case 7
            Set TargetRange = JulRange
        Case 8
            Set TargetRange = AugRange
        Case 9
            Set TargetRange = SepRange
        Case 10
            Set TargetRange = OctRange
        Case 11
            Set TargetRange = NovRange
        Case 12
            Set TargetRange = DecRange
    End Select

    'Setting this value on overall summary to copy it then once copied set it back to range. Also temporarily changing header highlight color
    Sht.Range("I2").Value = MonthName(Month(DateAdd("m", -1, Date))) & " " & Year(DateAdd("m", -1, Date)) & " Metrics"
    Sht.Range("I2:J2").Interior.ThemeColor = xlThemeColorAccent1

    'Copies the formatting from the Orange Summary table to the new area for formatting and such
    SumRange.Copy TargetRange

    'Replaces the Sheet name Combined Data with the sheet name of the new sheet in all the formulas
    TargetRange.Replace What:="Combined Data", Replacement:=MonthName(Month(DateAdd("m", -1, Date))) & " " & Year(DateAdd("m", -1, Date)) & " Data"

    Sht.Range("I2").Value = Replace(Sht.Range("A2").Value, " Metrics", "") & " Through " & MonthName(Month(DateAdd("m", -1, Date))) & " " & Year(DateAdd("m", -1, Date))
    Sht.Range("I2:J2").Interior.ThemeColor = xlThemeColorAccent4


    'Cleaning out tables and data if it is January of new Year
    If Month(DateAdd("m", -1, Date)) = 1 Then
        Sht.Range("A19:F200").ClearContents
        Sht.Range("A19:F200").ClearFormats
        Sht.Range("E1:F18").ClearContents
        Sht.Range("E1:F18").ClearFormats
        x = 2
        comLastRow = comSht.UsedRange.Rows.Count
        While x <= comLastRow
            If comSht.Range("E" & x).Value < DateAdd("d", -Day(Date) + 1, DateAdd("m", -1, Date)) Then
                comSht.Cells(x, 1).EntireRow.Delete
                comLastRow = comLastRow - 1
                x = x - 1
            End If
            x = x + 1
        Wend


        'If February then deleting all of the sheets except Over View and January tab
        Dim wSht As Worksheet
        For Each wSht In ThisWorkbook.Worksheets
            If wSht.Name <> "Over View" And wSht.Name <> "Combined Data" And wSht.Name <> MonthName(Month(DateAdd("m", -1, Date))) & " " & LastMonthYear & " Data" Then
                wSht.Delete
            End If
        Next

    End If


    Sht.Activate

    Sht.Cells(1, 1).Select

    ThisWorkbook.Save

    If Month(DateAdd("m", -1, Date)) = 1 Then
        ThisWorkbook.SaveAs "C:\Users\Connor.Osborne\Desktop\alex work project " & LastMonthYear & " Data.xlsx", xlWorkbookDefault
    Else
        ThisWorkbook.SaveAs "C:\Users\Connor.Osborne\Desktop\alex work project" & "-" & MonthName(Month(DateAdd("m", -1, Date)), True) & " " & LastMonthYear & " Data.xlsx", xlWorkbookDefault
    End If


    ThisWorkbook.Saved = True
    Application.DisplayAlerts = True
    If Application.Workbooks.Count = 1 Then
        Application.Quit
    Else
        ThisWorkbook.Close
    End If
    Exit Sub


    ThisWorkbook.Saved = True
    If Application.Workbooks.Count = 1 Then
        Application.Quit
    Else
        ThisWorkbook.Close
    End If

End Sub

此代码将从合并的数据表中输出单独的表,并通过某些计算来创建摘要表。

0 个答案:

没有答案