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 回答