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は Stringですが、 rngItemは Range です。

情報に空白がある場合は、最後に使用したセルを呼び出す関数から行を取得することをお勧めします。

set lastCell = Sheets().Cells.SpecialCells xlCellTypeLastCell

そしてその後

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

行を取得するか、必要な場合は範囲​​を取得します。

その後、その値を必要なものに変更できます。

これがお役に立てば幸いです!

于 2013-08-01T21:30:03.620 に答える