循环遍历多个数据集的代码 – find空白单元格时停止

好吧，也许我需要修改这个以获得更多的回应; ）

下面的代码工作正常，并执行以下操作;

它查找列B中所示的所需数据（列C是通过偏移号码的复制目的地）

将其引导至以下数据 – 获取单元格B12：B23中的所有信息;

然后将这些信息粘贴在下面的表格中;

迄今为止都很好。 现在我需要做的是查找源数据的D，F，H，J＆L列中的剩余信息，并将其粘贴到上面显示的数据下面的后续行中。

Private Sub MultipleItemExtract(strFileName As String, rngItem As Range, rngDataWrite As Range) ' Copies all data in specified cell addresses of specified worksheets ' of strFileName to specified columns of row rngDataWrite in active sheet. ' ' parameters: strFileName - data type String - name of file to search in ' rngDataWrite - data type Range - write location ' rngWSandItems - data type Range - worksheet and items location ' rngColumn - data type Range - destination column location ' ' notes for external parameters (in "Parameters" worksheet): ' Data from separate worksheets to be exactly one line apart ' Data from within the same worksheet to be zero lines apart ' Do not insert columns between the "Item", "Address" and "Destination" columns Dim strCurrentWorksheet As String While rngItem <> "" 'set current worksheet strCurrentWorksheet = rngItem 'move to items Set rngItem = rngItem.Offset(1, 0) With Workbooks(strFileName).Worksheets(strCurrentWorksheet) While rngItem <> "" Cells(rngDataWrite.row, rngItem.Offset(0, 2)) = .Range(rngItem.Offset(0, 1).Value) Set rngItem = rngItem.Offset(1, 0) Wend End With 'skip the space between worksheets Set rngItem = rngItem.Offset(1, 0) Wend End Sub 

我非常乐意接受这里的聊天工具来讨论是否需要，我真的需要解决这个问题，我非常感谢你的所有意见。

谢谢你们！ 马特

Answer 1

我相信你需要更好地解释如何格式化表格。 例如，如果信息之间有任何空格。

现在到你的代码。 这行是不是会抛出一个错误？

 strCurrentWorksheet = rngItem 

strCurrentWorksheet是一个string，而rngItem是一个范围。

如果您的信息有任何空格，我build议从调用最后一个单元格的函数获取该行。

 set lastCell = Sheets().Cells.SpecialCells xlCellTypeLastCell 

然后做

 lastRow = Cells(lastCell.Row, columnNeeded).End(xlUp).Offset(1, 0).Row 

获得行，或范围，如果这是你所需要的。

之后，你可以改变它的价值，你需要什么。

希望这可以帮助你！