-1

VLookup と Index&Match で試してみましたが、VBA ループだけが役に立ちます。

最初のワークシートに日付で始まるリストがあります。ここで、このリストをループして、リストの最初の列の日付の月と年が 2 番目のワークシートの月と年と一致するかどうかを確認します。その場合、一致する日付の残りの行の情報をワークシート 2 にコピーする必要があります。

ここにいくつかのサンプル データを含むワークシートをアップロードしました: https://cignifi.box.com/s/a6k03lh0bfe9ob53d4jy

すべての助けをいただければ幸いです。VBAについてはある程度理解していますが、この種の質問には十分ではありません...

どうもありがとう！

4

1 に答える 1

0

あなたの完成品がどうあるべきかはわかりませんが、このサブルーチンはあなたの要求どおりに機能します。Sheet2 に既に存在する情報は、Sheet1 のテーブルの情報で上書きされます。これがあなたが探していたものではない場合はお知らせください。
最初に変数を変更することで、データが転送される列と転送される列を調整できます。

編集:次の空白のアカウント名列をチェックし、その行番号を使用してコピーするコードを追加しました: 

Sub ProcessTableData()
    Dim wsSource, wsDestination As Worksheet
    Dim rowSourceStart, colSourceDate, rSource, colDestStart As Long
    Dim rowDestMonthYear, cDest, rowDestInsertAt As Long
    Dim destBlankColumnCount As Integer
    Dim colDestRegion, colDestAccountName, colDestPotentialName As Integer
    Dim colDestAmount, colDestWeightedAmount As Integer
    Dim colSourceRegion, colSourceAccountName, colSourcePotentialName As Integer
    Dim colSourceAmount, colSourceWeightedAmount As Integer

    Set wsSource = Sheet1
    Set wsDestination = Sheet2

    'Destination column offsets from month column
    colDestRegion = 0
    colDestAccountName = 1
    colDestPotentialName = 2
    colDestAmount = 3
    colDestWeightedAmount = 4

    'Source columns
    colSourceRegion = 5
    colSourceAccountName = 3
    colSourcePotentialName = 4
    colSourceAmount = 6
    colSourceWeightedAmount = 7

    colSourceDate = 2 'Source column for date
    rowSourceStart = 3 'Source starting row

    rowDestMonthYear = 2 'Destination row to check for month & year matching

    rSource = rowSourceStart
    'loop until the date field on the source sheet is blank
    Do While wsSource.Cells(rSource, colSourceDate).Value <> ""
        cDest = 1
        destBlankColumnCount = 0
        'loop through the destination columns until we've seen 5 blanks
        '(only 3 are ever expected)
        Do Until destBlankColumnCount > 5
            If wsDestination.Cells(rowDestMonthYear, cDest).Value <> "" Then
                destBlankColumnCount = 0
                'check if month matches
                If Month(wsSource.Cells(rSource, colSourceDate).Value) = wsDestination.Cells(rowDestMonthYear, cDest).Value Then
                    'check if year matches
                    If Year(wsSource.Cells(rSource, colSourceDate).Value) = wsDestination.Cells(rowDestMonthYear, (cDest + 1)).Value Then
                        'find last row to copy data to by finding the next blank "Account Name" row
                        rowDestInsertAt = (rowDestMonthYear + 2)
                        Do Until wsDestination.Cells(rowDestInsertAt, (cDest + colDestAccountName)).Value = ""
                            rowDestInsertAt = rowDestInsertAt + 1
                        Loop
                        'copy field data
                        wsDestination.Cells(rowDestInsertAt, (cDest + colDestAccountName)).Value = wsSource.Cells(rSource, colSourceAccountName).Value
                        wsDestination.Cells(rowDestInsertAt, (cDest + colDestPotentialName)).Value = wsSource.Cells(rSource, colSourcePotentialName).Value
                        wsDestination.Cells(rowDestInsertAt, (cDest + colDestRegion)).Value = wsSource.Cells(rSource, colSourceRegion).Value
                        wsDestination.Cells(rowDestInsertAt, (cDest + colDestAmount)).Value = wsSource.Cells(rSource, colSourceAmount).Value
                        wsDestination.Cells(rowDestInsertAt, (cDest + colDestWeightedAmount)).Value = wsSource.Cells(rSource, colSourceWeightedAmount).Value
                    End If
                End If
            Else
                destBlankColumnCount = destBlankColumnCount + 1
            End If
            cDest = cDest + 1
        Loop
        rSource = rSource + 1
    Loop

End Sub
于 2013-03-08T23:34:34.197 に答える