尝试在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
此代码将从合并的数据表中输出单独的表,并通过某些计算来创建摘要表。