0

https://www.dropbox.com/s/f83y17dedajbsz8/example.xls

これは、私がこれを機能させたいものの簡単なサンプルワークブックです。

現在、シート1（メイン）には、他のすべてのワークシートのデータを手動でコピーする必要があります。現在、私が行っているのは、必要な一意のコードのリストがあり、そのコードのシートとctrl + Fに移動し、その行を手動でコピーしてシート1（メイン）に貼り付けます。少し時間がかかる場合があります。

代わりに、シート1の列Dの任意のセルに一意のコードを入力するだけで、そのコードが他のシートのコードと一致する場合は、行全体がシート1にコピーされます。

これは簡単に実行できますか？

4

1 に答える 1

0

次の VBA はトリックを行う必要がありますSheet1 (Main)。.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Sheet As Worksheet
Dim Index As Integer
Dim Count As Integer
Dim Match As Range

    If Target.Rows.Count > 1 Or Target.Columns.Count > 1 Then
        ' You've done something that has edited lots of cells. Cant handle this.
        Exit Sub
    End If

    Set Sheet = ThisWorkbook.Worksheets("Main")

    If Not Intersect(Sheet.Range("D:D"), Target) Is Nothing Then
        ' The edited cell falls in the range D:D
        Count = ThisWorkbook.Worksheets.Count

        For Index = 1 To Count
            If Not ThisWorkbook.Worksheets(Index).Name = Sheet.Name Then
                Set Match = ThisWorkbook.Worksheets(Index).Range("D:D").Find(What:=Target.Value, LookIn:=xlValues)
                If Not Match Is Nothing Then
                    'copy the line across
                    ThisWorkbook.Worksheets(Index).Range("A" & Match.Row & ":E" & Match.Row).Copy Sheet.Range("A" & Target.Row)
                    Exit For
                End If
            End If
        Next Index

    End If

    If Match Is Nothing Then
    ' optional, if the target string is  not found clear the line.
        Sheet.Range("A" & Target.Row & ":E" & Target.Row).ClearContents
    End If

End Sub
于 2013-03-14T00:26:11.610 に答える