-2

私が抱えているこの課題の解決策をウェブで探しましたが、適切な解決策が見つかりませんでした。私は数式は得意ですが、VBA や Excel 内でのその他のプログラミングの経験はありません。多くの Excel の専門家の 1 人が、この課題を解決するのに役立つことを願っています。

サンプル シート https://dl.dropboxusercontent.com/u/95272767/Sample%20Sheet.xlsx

データの行は常に行 4 から始まり、行 1000 まで拡張できます。

基になる数式によって生成されたデータのシート (上記のリンク) があります。私の目標は、数式と元のデータの両方をそのまま残しながら、同じ行の列 F の内容に基づいてデータの部分的な行をコピーすることです。4 より上の行と列 O は、元のシートに残す必要があります。

例えば...

行 4 の列 F には ab1 があります。次のセル A4 から N4 を、Client 1 というラベルの付いたシートにコピーする必要があります。

行 5 の列 F には ab1 があります。次のセル A5 から N5 を、Client 1 というラベルの付いたシートにコピーする必要があります。

行 5 の列 F には ab2 があります。次のセル A6 から N6 を、Client 2 というラベルの付いたシートにコピーする必要があります。

このプロセスはデータの最後まで続きます。

提供できる支援を事前にありがとうございます。

乾杯スコット

4

1 に答える 1

1

このような何かがあなたを始めさせるはずです。マクロで何が起こっているかを説明するために、かなり徹底的にコメントしようとしました。

Sub CopySomeCells()
Dim targetSheet As Worksheet 'destination for the copied cells'
Dim sourceSheet As Worksheet 'source of data worksheet'
Dim rng As Range 'range variable for all data'
Dim rngToCopy As Range 'range to copy'
Dim r As Long 'row counter'
Dim x As Long 'row finder'
Dim clientCode As String
Dim clientSheet As String

Set sourceSheet = Worksheets("Sheet1") '## The source data worksheet, modify as needed ##
    With sourceSheet
        '## the sheet may have data between rows 4 and 1000, modify as needed ##'
        Set rng = .Range("A4", Range("A1000").End(xlUp))

        '## iterate over the rows in the range we defined above ##'
        For r = 1 To rng.Rows.Count


            '## Set the range to copy ##'
            Set rngToCopy = Range(rng.Cells(r, 1), rng.Cells(r, 12))

            '## ignore rows that don't have a value in column F ##
            If Not rng.Cells(r, 6).Value = vbNullString Then

                '## Set the targetSheet dynamically, based on the code in column F ##'
                '  e.g., "ab1" --> Client 1, "ab2" --> Client 2, etc. '
                '## Set the client code ##"
                clientCode = rng.Cells(r, 6).Value

                '## determine what sheet to use ##'
                ' I do this by finding the client code in the lookup table, which
                ' is in range "O24:O37", using the MATCH function.
                ' Then, offset it -1 rows (the row above) which will tell us "Client Code 1", etc.

                clientSheet = .Range("O23").Offset( _
                    Application.Match(clientCode, .Range("O24:O37"), False), 0).Offset(-1, 0).Value
                ' take that value "Client Code 1" and replace "Code " with nothing, so that
                ' will then give us the sheet name, e.g., "Client Code 1" --> "Client 1", etc. ##'
                clientSheet = Replace(clientSheet, "Code ", vbNullString)

                Set targetSheet = Worksheets(clientSheet)

                '## Find the next empty row in this worksheet ##'
                x = Application.WorksheetFunction.CountA(targetSheet.Range("A:A")) + 1

                '## Copy the selected sub-range, ##'

                rngToCopy.Copy 

                '## Paste values only to the target sheet ##'
                targetSheet.Cells(x, 1).PasteSpecial Paste:=xlPasteValues, _
                    Operation:=xlNone, SkipBlanks:=False, Transpose:=False

            End If

        Next '## proceed to process the next row in this range ##'

    End With

End Sub
于 2013-05-09T03:11:43.757 に答える