-1

特定の条件を満たす場合に、隣接するワークシートから現在のワークシートにセルをコピーするマクロ (または関数) を作成する必要があります。

以下は、所有者、チケット、およびコメント フィールドを含む現在のワークシートに隣接するワークシートです。これらのフィールドを、現在のワークシートの適切なアプリケーション名とオブジェクト (一意の ID として連結) にコピーする必要があります。

ここに画像の説明を入力

以下は、上記のフィールドをコピーする必要がある現在のワークシートです。アプリケーションが同じ順序でリストされていないことに注意してください。これは、データがどの順序になるか、または同じデータが新しいワークシートにあるかどうかがわからないためです。

ここに画像の説明を入力

これまでのところ、私はこの機能を試しました:

=IF(INDIRECT(NextSheetName()&"!A3")&INDIRECT(NextSheetName()&"!B3") = A3&B3, INDIRECT(NextSheetName()&"!D3"), "0")

ワークシートに同じデータが同じ順序である場合にのみ機能します。

これを行う方法を知っている人はいますか？

4

1 に答える 1

1

VBA を使用してこれを行う場合は、次のことを試してください。このコードは、一致する行をソース ワークシートからターゲット ワークシートにコピーし、ソースの一致する行をターゲットに記録します。シートに「ソース」と「ターゲット」という名前を付け、列 A と B の連結で一致させたいと想定しています。

ソースとターゲットの行数は重要ではなく、一致が表示される順序も重要ではありません。

私は2つの異なるバージョンを書きました。最初の方法は機能しますが、ソース範囲をループしてターゲットの各値に一致するものを探しているため、私はそれについて夢中になっているわけではありません。2 番目のバージョンでは、一度作成されたディクショナリを使用します。検索語の一致は、範囲をループすることなく実行されます。辞書を使用するには、Microsoft Scripting Runtime への参照が必要になることに注意してください。

最初のバージョン: (機能しますが、複数のループが必要です)

Sub GetTwoColumnMatches()

    Dim wsrc As Worksheet
    Dim wTgt As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim lLastTargetRow As Long
    Dim lMatchedRow As Long
    Dim sConcat As String

    Set wsrc = Sheets("Source")
    Set wTgt = Sheets("Target")
    lLastTargetRow = wTgt.Range("A" & wTgt.Rows.Count).End(xlUp).Row


    Set rng = wTgt.Range("a2:a" & lLastTargetRow)
    For Each cell In rng
        sConcat = cell & cell.Offset(, 1)
        lMatchedRow = Matches(sConcat)
        If lMatchedRow <> 0 Then
            wTgt.Range("a" & cell.Row & ":e" & cell.Row).Value = _
            wsrc.Range("a" & lMatchedRow & ":e" & lMatchedRow).Value
            wTgt.Range("f" & cell.Row) = lMatchedRow
        End If
    Next
End Sub

Function Matches(SearchFor As String) As Long
    Dim wsrc As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim lLastSourceRow As Long
    Dim lSourceRow As Long

    Set wsrc = Sheets("Source")
    lLastSourceRow = wsrc.Range("a" & wsrc.Rows.Count).End(xlUp).Row

    Set rng = wsrc.Range("a2:a" & lLastSourceRow)
    Matches = 0
    For Each cell In rng
        If cell & cell.Offset(, 1) = SearchFor Then
            Matches = cell.Row
            Exit For
        End If
    Next
End Function

2 番目のバージョン: (最適化、Microsoft Scripting Runtime への参照が必要)

Sub GetTwoColumnMatches()

    Dim wsrc As Worksheet
    Dim wTgt As Worksheet
    Dim rng As Range
    Dim cell As Range
    Dim srcRng As Range
    Dim srcCell As Range

    Dim lLastTargetRow As Long
    Dim lLastSourceRow As Long
    Dim lMatchedRow As Long
    Dim lSourceRow As Long

    Dim sConcat As String
    Dim dict As Dictionary

    Set wsrc = Sheets("Source")
    Set wTgt = Sheets("Target")
    lLastTargetRow = wTgt.Range("A" & wTgt.Rows.Count).End(xlUp).Row

    Set wsrc = Sheets("Source")
    lLastSourceRow = wsrc.Range("a" & wsrc.Rows.Count).End(xlUp).Row

    'Create the dictionary
    Set dict = New Dictionary

    Set srcRng = wsrc.Range("a2:b" & lLastSourceRow)
    For Each srcCell In srcRng
        sConcat = srcCell & srcCell.Offset(, 1)
        If Len(sConcat) > 0 Then dict.Add sConcat, srcCell.Row
    Next

    Set rng = wTgt.Range("a2:a" & lLastTargetRow)
    For Each cell In rng
        sConcat = cell & cell.Offset(, 1)
        lMatchedRow = dict.Item(sConcat)
        If lMatchedRow <> 0 Then
            wTgt.Range("a" & cell.Row & ":e" & cell.Row).Value = _
            wsrc.Range("a" & lMatchedRow & ":e" & lMatchedRow).Value
            wTgt.Range("f" & cell.Row) = lMatchedRow
        End If
    Next
End Sub

Microsoft Scripting Runtime を正しく選択すると、参照は次のようになります。

Microsoft Scripting Runtime への参照

于 2012-08-10T03:44:12.230 に答える