Option Explicit
Public Sub consolidateList()
DeleteTableRows (ThisWorkbook.Worksheets("Master").ListObjects("MasterSheet"))
FillTableRows
End Sub
Private Sub FillTableRows()
'set up worksheet objects
Dim wkSheet As Worksheet
Dim wkBook As Workbook
Dim wkBookPath As String
Set wkBook = ThisWorkbook
wkBookPath = wkBook.Path
Set wkSheet = wkBook.Worksheets("Master")
'set up file system objects
Dim oFile As Object
Dim oFSO As Object
Dim oFolder As Object
Dim oFiles As Object
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFolder = oFSO.GetFolder(wkBookPath)
Set oFiles = oFolder.Files
'set up loop
Dim checkBook As Excel.Workbook
Dim reportDict As Dictionary
Application.ScreenUpdating = False
'initial coordinates
Dim startRow As Long
Dim startColumn As Long
startColumn = 3
Dim i As Long 'tracks within the row of the sheet where information is being pulled from
Dim k As Long 'tracks the row where data is output on
Dim j As Long 'tracks within the row of the sheet where the data is output on
Dim Key As Variant
j = 1
k = wkSheet.Range("a65536").End(xlUp).Row + 1
Dim l As Long
'look t Set checkBook = Workbooks.Open(oFile.Path)hrough folder and then save it to temp memory
On Error GoTo debuger
For Each oFile In oFiles
startRow = 8
'is it not the master sheet? check for duplicate entries
'oFile.name is the name of the file being scanned
'is it an excel file?
If Mid(oFile.Name, Len(oFile.Name) - 3, 4) = ".xls" Or Mid(oFile.Name, Len(oFile.Name) - 3, 4) = ".xlsx" Then
Set checkBook = Workbooks.Open(oFile.Path)
For l = startRow To 600
If Not (IsEmpty(Cells(startRow, startColumn))) Then
'if it is, time do some calculations
Set reportDict = New Dictionary
'add items of the payment
For i = 0 To 33
If Not IsEmpty(Cells(startRow, startColumn + i)) Then
reportDict.Add Cells(4, startColumn + i), Cells(startRow, startColumn + i)
End If
Next i
For i = startRow To 0 Step -1
If Not IsEmpty(Cells(i, startColumn - 1)) Then
reportDict.Add "Consumer Name", Cells(i, startColumn - 1)
Exit For
End If
Next i
'key is added
For Each Key In reportDict
'wkSheet.Cells(k, j) = reportDict.Item(Key)
Dim myInsert As Variant
Set myInsert = reportDict.Item(Key)
MsgBox (myInsert)
wkSheet.ListObjects(1).DataBodyRange(2, 1) = reportDict.Item(Key)
j = j + 1
Next Key
wkSheet.Cells(k, j) = wkSheet.Cells(k, 9) / 4
wkSheet.Cells(k, j + 1) = oFile.Name
'
k = k + 1
' Set reportDict = Nothing
j = 1
Else
l = l + 1
End If
startRow = startRow + 1
Next l
checkBook.Close
End If
' Exit For
Next oFile
Exit Sub
debuger:
MsgBox ("Error on: " & Err.Source & " in file " & oFile.Name & ", error is " & Err.Description)
End Sub
Sub DeleteTableRows(ByRef Table As ListObject)
On Error Resume Next
'~~> Clear Header Row `IF` it exists
Table.DataBodyRange.ClearContents
'~~> Delete all the other rows `IF `they exist
Table.DataBodyRange.Offset(1, 0).Resize(Table.DataBodyRange.Rows.count - 1, _
Table.DataBodyRange.Columns.count).Rows.Delete
On Error GoTo 0
End Sub
问候。上面的代码将保存在excel电子表格中的数据文件夹合并为一个主excel电子表格。目的是在名为master的工作表上的名为master的Excel Spreadsheet上运行宏,该宏在文件夹中打开其他excel工作簿,获取信息,并将其放入工作表“ master”中的表中。在这之后,很容易看到信息。因此,记录不是保存在数百个工作表上,而是保存在一个工作表上。
该代码使用词典(reportDict)临时存储各个工作簿所需的信息。然后的目标是获取该信息并将其放在主表的底部行,然后显然在成功放置数据之后或尝试放置数据之前添加新行。
代码在以下行失败:
wkSheet.ListObjects(1).DataBodyRange(2, 1) = reportDict.Item(Key)
失败描述是“对象或未设置变量”,因此问题出在reportDict.Item(Key)上。我的猜测是,VBA某种程度上无法将字典项识别为稳定的,但是我不知道如何纠正这一问题。最终目标是拥有可以做到的代码:
for each key in reportDict
- place the item which is mapped to the key at a unique row,column in the master table
- expand the table to accomodate necessary data
next key
答案 0 :(得分:2)
隐含的默认成员调用使您的代码无处不在。
reportDict.Add Cells(4, startColumn + i), Cells(startRow, startColumn + i)
这隐式地从当前Range.[_Default]
的任何工作表中访问ActiveSheet
(您是说要成为wkSheet.Cells
吗?),以获取Key
-自{{ 1}}参数是Key
,String
被隐式强制为1,并且您有一个字符串键。但是,该键上实际的字典项并不那么幸运。
这是MCVE:
Range.[_Default]
此过程将Public Sub Test()
Dim d As Dictionary
Set d = New Dictionary
d.Add "A1", Cells(1, 1)
Debug.Print IsObject(d("A1"))
End Sub
打印到调试窗格(Ctrl + G):您在字典中存储的不是一堆字符串值,而是一堆True
对象引用。
因此,当您这样做时:
Range
您最好也声明Dim myInsert As Variant
Set myInsert = reportDict.Item(Key)
,因为它是一个。
这是有趣的地方:
myInsert As Range
不要忘记强制评估对象的默认成员并将其MsgBox (myInsert)
传递给ByVal
函数的多余括号-在这里,您将MsgBox
隐式转换为Range.[_Default]
。那可能有效。
那为什么会失败?
String
通常不会。 VBA会很乐意这样做:
wkSheet.ListObjects(1).DataBodyRange(2, 1) = reportDict.Item(Key)
然后将值写入wkSheet.ListObjects(1).DataBodyRange.Cells(2, 1).[_Default] = reportDict.Item(Key).[_Default]
的{{1}}中的指定位置。
我认为那只是红鲱鱼。编写明确的代码:如果要存储单元格的DataBodyRange
,请存储单元格的ListObject
。如果您要分配单元格的Value
,请分配单元格的Value
。
我无法使用此设置复制错误91。
但是,这是
Value
... 也是强制评估Value
的默认成员-因此DeleteTableRows (ThisWorkbook.Worksheets("Master").ListObjects("MasterSheet"))
没有收到ListObject
,它得到了{ {1}}包含刚刚取消引用的对象的名称...但是DeleteTableRows
带有一个ListObject
参数,因此代码甚至都无法 get 才能运行String
-在DeleteTableRows
进入之前,它必须因类型不匹配而崩溃。实际上,是编译时错误。
因此,这是一个相当长的答案,无法理解该特定行上错误91的原因(我无法重现),但突出显示了您的代码中相当多的严重问题,它们非常非常可能 与您收到的此错误有关。希望对您有所帮助。
答案 1 :(得分:0)
您需要遍历字典的Keys集合。
dim k as variant, myInsert As Variant
for each k in reportDict.keys
debug.print reportDict.Item(k)
next k