循环遍历多个数据集的代码 - 在找到空白单元格时停止

Question

好吧，也许我需要对此进行修改以获得更多回复; ）

以下代码运行正常，并执行以下操作;

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

将其定向到以下数据 - 获取单元格B12中的所有信息：B23;

然后将此信息粘贴到以下表格中;

到目前为止一切都很好。现在我需要它做的是查找D，F，H，J和D列中的剩余信息。 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 是一个字符串，而 rngItem 是一个范围。

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

set lastCell = Sheets().Cells.SpecialCells xlCellTypeLastCell

之后再做

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

获取行或范围，如果它是你需要的。

之后，您可以将其值更改为您需要的值。

希望这能帮到你！