Question

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

这是我希望这个工作的快速示例工作簿。

现在，工作表1（主要）需要手动将所有其他工作表中的数据复制到其中。目前，我正在做的是我有一个我需要的唯一代码列表，然后我转到工作表并按ctrl + F获取该代码，然后手动复制+粘贴该行到工作表1（主要）。这可能有点耗时。

我想要做的只是简单地将任何唯一代码输入到表1中列D的任何单元格中，然后如果该代码与任何其他工作表上的代码匹配，则整行将复制到工作表1。

这很容易吗？

Answer 1

以下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

如果在匹配项中键入唯一代码，则将整个行从另一个工作表复制到工作表1

1 个答案: