好的,也许我需要修改它以获得更多响应 ;)
下面的代码可以正常工作并执行以下操作;
它查找 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
如果需要,我非常愿意在这里的聊天工具上讨论,我真的需要解决这个问题,我感谢您的所有意见。
谢谢你们!马特