如何根据单元格值将数据从一个工作表复制到另一个工作表

Question

我在一张表中有一个主数据集，就像这样

在另一个工作表中，我想根据一个以Department为标准的单元格值从该主数据集中提取数据。

所以，例如，如果在表2中我将我的部门标准键入为Sales，则所有具有Department as Sales的行都应填入表2中。

这可以通过excel函数/宏/ VBA来完成吗？ 提前致谢。 如果你觉得这个问题荒谬，请原谅我。

Answer 1

是的，可以做到。将此代码添加到工作簿中的模块。您可以直接从调试器运行它，或转到宏并为其分配一个热键，或者您可以在工作表上创建一个按钮并将此代码放在按钮单击事件中。可能有更有效的方法来做到这一点，但除非你有大量的数据，否则它并不重要。我已经明确了，所以你可以看到最新情况。我使用了工作表名称＆＃34; Data＆＃34;和＆＃34;查看＆＃34;您必须更改代码中的名称以匹配您的工作簿。

编辑：我还假设屏幕截图中的左上角单元格为A1，否则您将不得不调整代码。

Sub GetDepartments()

Dim LastRow As Long
Dim MyRange As Range
Dim SourceRow As Long
Dim DeptValue As String
Dim OutputRow As Long
Dim ColCounter As Long

'get size of current view sheet and clear
LastRow = ThisWorkbook.Worksheets("View").Cells(ThisWorkbook.Worksheets("View").Rows.Count, "A").End(xlUp).Row
If LastRow > 7 Then
  Set MyRange = ThisWorkbook.Worksheets("View").Range("A7:C" & LastRow)
  MyRange.ClearContents
End If

'get size of data sheet
LastRow = ThisWorkbook.Worksheets("Data").Cells(ThisWorkbook.Worksheets("Data").Rows.Count, "A").End(xlUp).Row
'get value to match
DeptValue = ThisWorkbook.Worksheets("View").Cells(3, 2).Value

'track outputrow
OutputRow = 7

'loop through all rows in data
For SourceRow = 2 To LastRow
  'if match found
  If ThisWorkbook.Worksheets("Data").Cells(SourceRow, 2).Value = DeptValue Then
    'copy 3 cols
    For ColCounter = 1 To 3
      ThisWorkbook.Worksheets("View").Cells(OutputRow, ColCounter).Value = _
        ThisWorkbook.Worksheets("Data").Cells(SourceRow, ColCounter).Value
    Next ColCounter
    'increment outputrow
    OutputRow = OutputRow + 1
  End If
Next SourceRow
End Sub