我写了下面的代码，以加快将交易数据汇总为简化格式的过程。
概述：我在一个Excel工作簿中管理40多家公司的簿记。所有交易都添加到中央表“合并数据”中，从那里我需要以比合并表中提供的格式更易于理解的格式，每月提供所有支出的摘要。
我当前在以下代码行中遇到错误：
Dim transactionsInPeriodNegative As Boolean
Set transactionsInPeriodNegative = sourceTable.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).count <= 1
If transactionsInPeriodNegative Then
正在编译时出错错误：必需的对象。我将在完整代码（在下面的副本中）中进一步使用类似的代码，因此将假定这些部分也将运行相同的错误。另外也不知道它是否重要，但是Code当前在模块4中。
在“本地”，“观看”或“即时”窗口中看不到任何内容，无法提供有关如何解决此问题的线索。
SUB UPDATEPAYMENTS()
'This Sub does the following
' Filter Amalgamated Table by dates defined on Overview Sheet
' 1. If no transactions within data range tell me
' a. Ask to continue and clear existing data from Summary
' b. Reset workbook and Exit Sub without doing anything further
' 2. If transactions do exist:
' a. Copy type “Payment” only
' b. Rearrange Data and reformat top Summary sheet format
' c. Filter to remove all incoming payments (values > 0)
' i. Message box if there are no outgoing payment in period
' 1. Ask to continue and clear existing data from Summary
' 2. Reset workbook and Exit Sub without doing anything further
' d. Copy payments to summary sheet (starting at Column I – existing data not to be touched or changed in Columns A - H)
' e. Reset workbook and confirm operation successful
Dim overviewSheet As Worksheet
Set overviewSheet = Sheets("Overview")
Dim paymentHelperSheet As Worksheet
Set paymentHelperSheet = Sheets("Payments")
Dim amalgamatedDateSheet As Worksheet
Set amalgamatedDateSheet = Sheets("Amalgamated Data")
Dim sourceTable As ListObject
Set sourceTable = amalgamatedDateSheet.ListObjects("TableFullData")
Dim paymentHelperTable As ListObject
Set paymentHelperTable = paymentHelperSheet.ListObjects("TablePaymentsInt")
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If paymentHelperSheet.Visible = xlSheetVeryHidden Then
paymentHelperSheet.Visible = xlSheetVisible
End If
amalgamatedDateSheet.Select
' Clear all filter from table
sourceTable.AutoFilter.ShowAllData
'Filter by Date
Dim dateStart As Long
dateStart = overviewSheet.Range("J8").Value
Dim dateEnd As Long
dateEnd = overviewSheet.Range("L8").Value
sourceTable.Range.AutoFilter Field:=4, _
Criteria1:=">=" & dateStart, _
Operator:=xlAnd, _
Criteria2:="<=" & dateEnd
' Filter by Payment Type
sourceTable.Range.AutoFilter Field:=8, _
Criteria1:="Payment"
'If no Transactions ask for next steps
Dim transactionsInPeriodNegative As Boolean
Set transactionsInPeriodNegative = sourceTable.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).count <= 1
If transactionsInPeriodNegative Then
Result = MsgBox("No payments within date range" & vbNewLine & "Do you want to continue?", vbYesNo + vbQuestion, "No payments")
If Result = vbNo Then
'Hide Payment intermediate sheet
sourceTable.AutoFilter.ShowAllData
overviewSheet.Select
paymentHelperSheet.Visible = xlSheetVeryHidden
'Update Screen updating
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Payment information not transferred"
Exit Sub
Else
overviewSheet.Select
Dim paymentFinalTable As Worksheet
Set paymentFinalTable = overviewSheet.ListObjects("Payments")
With paymentFinalTable
.AutoFilter.ShowAllData
.DataBodyRange.Offset(1).Resize(.DataBodyRange.Rows.count - 1, .DataBodyRange.Columns.count).Rows.Delete
.DataBodyRange.ClearContents
End With
End If
Else
'Copy Data to intermediate sheet
sourceTable.Range.SpecialCells(xlCellTypeVisible).Copy _
Destination:=paymentHelperSheet.Range("A4")
'Move Columns around
With paymentHelperSheet
.Cells.Validation.Delete
.Columns("G:G").Insert Shift:=xlToRight
.Range("g5").FormulaR1C1 = _
"=IF(RIGHT([@Facility],3)=""O/D"",[@Facility],CONCATENATE([@Facility],"" - "",[@Investment]))"
.Range("TablePaymentsInt[Column1]").Copy
.Range("TablePaymentsInt[Facility]").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.Columns("G:g").Delete
.Columns("D:D").Cut
.Columns("B:B").Insert Shift:=xlToRight
.Columns("G:G").Cut
.Columns("C:C").Insert Shift:=xlToRight
.Columns("D:E").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
.Columns("O:O").Cut
.Columns("J:J").Insert Shift:=xlToRight
'Move Payment data and copy as values
.Range("D5").FormulaR1C1 = _
"=IF(RC[8]<0,""EUR"",IF(RC[9]<0,""GBP"",IF(RC[10]<0,""USD"","""")))"
.Range("E5").FormulaR1C1 = _
"=IF(RC[7]<0,-RC[7],IF(RC[8]<0,-RC[8],IF(RC[9]<0,-RC[9],"""")))"
.Range("D:E").Copy
.Range("D:E").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
'Correct formatting of columns
.Columns("B:B").NumberFormat = "dd/mm/yyyy"
.Columns("C:D").NumberFormat = "General"
.Columns("E:E").Style = "Comma"
.Columns("F:H").NumberFormat = "General"
'Delete unnecessary columns
.Columns("G:H").Delete
.Columns("I:X").Delete
End With
'Filter all inward payments for deletion
paymentHelperTable.Range.AutoFilter Field:=4, Criteria1:="="
'Check if inward payments
Dim inwardPaymentsInRange As Boolean
Set inwardPaymentsInRange = paymentHelperTable.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).count > 1
If inwardPaymentsInRange > 1 Then
'If inward payments, delete rows
paymentHelperTable.EntireRow.Delete
End If
paymentHelperTable.AutoFilter.ShowAllData
Dim noFinalPaymentTransactionsInRange As Boolean
Set noFinalPaymentTransactionsInRange = paymentHelperTable.AutoFilter.Range.Columns(1).SpecialCells(xlCellTypeVisible).count <= 1
If noFinalPaymentTransactionsInRange Then
Result = MsgBox("No payments within date range" & vbNewLine & "Do you want to continue?", vbYesNo + vbQuestion, "No payments")
If Result = vbNo Then
'Hide Payment intermediate sheet
sourceTable.AutoFilter.ShowAllData
paymentHelperSheet.Visible = xlSheetVeryHidden
'Update Screen updating
Application.ScreenUpdating = True
Application.DisplayAlerts = True
MsgBox "Payment information not transferred"
Exit Sub
End If
End If
'Clear existing data
overviewSheet.Select
Dim paymentFinalTable As Worksheet
Set paymentFinalTable = overviewSheet.ListObjects("Payments")
With paymentFinalTable
.AutoFilter.ShowAllData
.DataBodyRange.Offset(1).Resize(.DataBodyRange.Rows.count - 1, .DataBodyRange.Columns.count).Rows.Delete
.DataBodyRange.ClearContents
End With
'Copy Data
Dim lastTargetRow As Long
lastTargetRow = overviewSheet.Range("I" & Rows.count).End(xlUp).Row
With paymentHelperSheet.DataBodyRange.SpecialCells(xlCellTypeVisible).Copy
With paymentFinalTable
.Range("I" & lastTargetRow).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:=xlNone
Application.CutCopyMode = False
End With
End With
' Clear all filter from table
sourceTable.AutoFilter.ShowAllData
paymentHelperTable.EntireRow.Delete
'Hide Payment intermediate sheet
paymentHelperSheet.Visible = xlSheetVeryHidden
'Update Screen updating
'Message successful
End If
MsgBox "Payments Transferred"
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub