Vba 如何基于单元格值将数据从一张图纸复制到另一张图纸

我有一个像这样的主数据集

在另一张表中，我想根据单元值从主数据集中提取数据，单元值将以部门为标准

因此，例如，如果在表2中，我将我的部门标准输入为Sales，那么所有以Department作为Sales的行都应该填充到表2中

这可以通过excel函数/宏/VBA实现吗？ 提前谢谢。

---

如果你觉得这个问题很荒谬，请原谅。

是的，可以做到。将此代码添加到工作簿中的模块。您可以直接从调试器运行它，或者转到宏并为其指定热键，或者您可以在工作表上创建一个按钮，并将此代码放入button click事件中。也许有更有效的方法可以做到这一点，但除非你有大量的数据，否则这并不重要。我已经说得很清楚了，所以你可以看到发生了什么。我使用了工作表名称“数据”和“视图”，您必须更改代码中的名称以匹配工作簿

编辑：我还假设屏幕截图中左上角的单元格是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

---

是的，可以做到。让我们看看到目前为止你都做了些什么。