VBA cellextract为多个xlsx文件返回运行时错误9
在工作中，我收到大量的PDF表格。 进入表格进入PDF格式的表格。 PDF中的特定条目必须input到Excel工作表中（从现在起被称为跟踪器）。 添加每个条目非常繁琐。 这种方法也容易出错。
然后我确定可以将每个PDF转换为.xlsx文件，保持表格格式。 有了细胞参考，我做了一个VLOOKUP公式来提取我需要的跟踪器的确切信息。 我只需将新创build的转换.xlsx的表格范围复制/粘贴到我的VLOOKUP提取器.xlsx中，然后填充所需的信息以粘贴到跟踪器中。
但是，使用这种方法，我仍然需要将多个PDF文件转换为.xlsx文件，逐个打开它们，将表格粘贴到提取器.xlsx中，然后将新提取的数据复制并粘贴到跟踪器中。 所以，还是不太高效。 我确定我需要一个macros。
我发现的macros应该循环通过指定文件夹中的.xlsx文件，打开它们并search指定的单元格。 正如你在下面的macros中看到的，单元格不在任何一个范围内。 我必须从特定的单元格中提取值。
接下来，它应该从指定的单元格中提取值，并按照从macros运行的表单中的指示填充它们。
但是，无论我做什么，我都会得到“ 运行时错误9下标超出范围 ”。 debugging指向以下代码行作为错误的原因9： Set OpenWorksheet = OpenWorkbook.Worksheets(SheetName)
我试图用Table1replaceSheetName在有问题的行中，只是为了得到相同的错误。 试图Sheet1但后来得到运行时错误13。
我一直在寻找networking几个小时，但我不能find类似于我的情况。 任何帮助，将不胜感激。
macros如下：
Sub ExtractCells() ' local wb vars Dim wb As Workbook Dim ws As Worksheet Dim MySheet As String Dim r1 As Range Dim r2 As Range Dim r3 As Range Dim r4 As Range Dim r5 As Range Dim r6 As Range Dim r7 As Range Dim r8 As Range Dim r9 As Range Dim r10 As Range Dim r11 As Range Dim r12 As Range Dim i As Integer ' opened wb vars Dim OpenWorkbook As Workbook Dim OpenWorksheet As Worksheet Dim SheetName As String ' looping params Dim Directory As String Dim FileSpec As String Dim MyFile As String ' define looping params Directory = "C:\MultiPD Test\Forms\" 'CHANGE THIS FileSpec = ".xlsx" 'CHANGE THIS IF NECESSARY MyFile = Dir(Directory & "*" & FileSpec) SheetName = "Table1" 'CHANGE THIS ' set local vars Set wb = ThisWorkbook MySheet = "Sheet1" 'CHANGE THIS Set ws = wb.Worksheets(MySheet) ' This is where data will begin to write Set r1 = ws.Range("A1") Set r2 = ws.Range("B1") Set r3 = ws.Range("C1") Set r4 = ws.Range("D1") Set r5 = ws.Range("E1") Set r6 = ws.Range("F1") Set r7 = ws.Range("G1") Set r8 = ws.Range("H1") Set r9 = ws.Range("I1") Set r10 = ws.Range("J1") Set r11 = ws.Range("K1") Set r12 = ws.Range("L1") i = 0 ' If there is one thing you take away from this, it should be the construct below ie how to loop through files Do While MyFile <> "" Set OpenWorkbook = Application.Workbooks.Open(Filename:="C:\MultiPD Test\Forms\*.xlsx", ReadOnly:=True) Set OpenWorksheet = OpenWorkbook.Worksheets(SheetName) ' write data down col With OpenWorksheet r1.Offset(i, 0).Value = .Range("C4").Value r2.Offset(i, 0).Value = .Range("C6").Value r3.Offset(i, 0).Value = .Range("C8").Value r4.Offset(i, 0).Value = .Range("C10").Value r5.Offset(i, 0).Value = .Range("C12").Value r6.Offset(i, 0).Value = .Range("C15").Value r7.Offset(i, 0).Value = .Range("C16").Value r8.Offset(i, 0).Value = .Range("C22").Value r9.Offset(i, 0).Value = .Range("C35").Value r10.Offset(i, 0).Value = .Range("C36").Value r11.Offset(i, 0).Value = .Range("C37").Value r12.Offset(i, 0).Value = .Range("C38").Value End With i = i + 1 MyFile = Dir Loop End Sub
正如在评论中提到的那样：
- 应该抛出运行时错误1004：文件“…”的第一行无法find是这样的：
Application.Workbooks.Open(Filename:="C:\MultiPD Test\Forms\*.xlsx", ReadOnly:=True) - 下一个问题是“Table1”不是一个有效的工作表名称（它似乎是一个ListObject名称）
- 将.XLSX文件中的所有工作表重命名为Sheet1后，您的代码就可以工作
下面的版本使用数组来减less重复：
Option Explicit Public Sub ExtractCellsFromMultiFiles() Const SRC_COL = 3 Dim thisWS As Worksheet, wsName As String, srcRows As Variant Dim foldr As String, srcFile As String, ext As String srcRows = Array(4, 6, 8, 10, 12, 15, 16, 22, 35, 36, 37, 38) wsName = "Sheet1" 'Not "Table1", which is probably a ListObject Table name Set thisWS = ThisWorkbook.Worksheets(wsName) foldr = "C:\MultiPD Test\Forms\" ext = ".xlsx" srcFile = Dir(foldr & "*" & ext) Dim srcWB As Workbook, srcWS As Worksheet, i As Long, j As Long i = 1 Application.ScreenUpdating = False Do While Len(srcFile) > 0 Set srcWB = Workbooks.Open(Filename:=foldr & srcFile, ReadOnly:=True) Set srcWS = srcWB.Worksheets(wsName) For j = 1 To UBound(srcRows) + 1 thisWS.Cells(i, j).Value2 = srcWS.Cells(srcRows(j - 1), SRC_COL).Value2 Next i = i + 1 srcWB.Close False srcFile = Dir Loop Application.ScreenUpdating = True End Sub
输出：
ColA ColB ColC ColD ColE ColF ColG ColH ColI ColJ ColK ColL ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- ----- S1C4 S1C6 S1C8 S1C10 S1C12 S1C15 S1C16 S1C22 S1C35 S1C36 S1C37 S1C38 S2C4 S2C6 S2C8 S2C10 S2C12 S2C15 S2C16 S2C22 S2C35 S2C36 S2C37 S2C38 S3C4 S3C6 S3C8 S3C10 S3C12 S3C15 S3C16 S3C22 S3C35 S3C36 S3C37 S3C38