1

好的，也许我需要修改它以获得更多响应 ；)

下面的代码可以正常工作并执行以下操作；

它查找 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

如果需要，我非常愿意在这里的聊天工具上讨论，我真的需要解决这个问题，我感谢您的所有意见。

谢谢你们！马特

4

1 回答 1

1

我相信您需要更好地解释工作表的格式。例如，信息之间是否有空格。

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

strCurrentWorksheet = rngItem

strCurrentWorksheet是一个字符串，而rngItem是一个范围。

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

set lastCell = Sheets().Cells.SpecialCells xlCellTypeLastCell

然后做

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

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

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

希望这对你有帮助！

于 2013-08-01T21:30:03.620 回答