在 Excel 中使用 VBA 根据单元格值从一张工作表中提取数据到新工作表中

Question

我目前正在尝试为 Excel 中的质量报告创建自动行动计划表。 源表是下图中表格的扩展版本，并列出了更大“查询区域”内每个子参考的分数：

源表图片

我正在尝试编写一个脚本，该脚本将循环遍历源表中的 C 列，并且分数为 -5 或 0，我想从 B 列中提取引用并将其放置在源表中的下一个可用行中名为“行动计划”的表格的第一栏。因此，以上表为例，我希望行动计划表与下表类似：

行动计划表中的预期结果

我目前有下面的脚本，但是虽然我没有收到任何错误，但除了跳转到源表 C 列的第一行之外似乎没有发生任何事情。

Sub newloop()

Dim lRow As Integer
Dim lastrow As Integer
Dim FRow As Integer
Dim domainws As Worksheet
Dim apws As Worksheet

Set domainws = ActiveWorkbook.Worksheets("Safe")
Set apws = ActiveWorkbook.Worksheets("Action Plan")

lastrow = apws.Cells(Rows.Count, 2).End(xlUp).Row + 1
lRow = domainws.Cells(Rows.Count, 2).End(xlUp).Row

domainws.Activate

For FRow = 3 To lRow
    If domainws.Cells(FRow, 22) = "0" Then
        apws.Cells(lastrow, 2).Value = domainws.Cells(FRow, 2)
    ElseIf domainws.Cells(FRow, 22) = "-5" Then
        apws.Cells(lastrow, 2).Value = domainws.Cells(FRow, 2)
    End If
Next FRow

End Sub
    

作为奖励，我确实有五个不同的源表，我还需要循环遍历（所有数据都在同一个地方，它们只是有不同的行数），所以理想情况下希望这一切都发生在同一个循环中，但是如果需要的话，我也可以复制并调整其他四张纸的循环。

非常感谢您提供的任何指导。

Answer 1

这应该可以解决您的问题：

Sub newloop()

Dim lRow As Long
Dim lastrow As Long
Dim FRow As Long
Dim domainws As Worksheet
Dim apws As Worksheet

Set apws = ActiveWorkbook.Worksheets("Action Plan")

For Each domainws In ActiveWorkbook.Sheets
    If domainws.Name <> "Action Plan" Then
        lRow = domainws.Cells(domainws.Rows.Count, 2).End(xlUp).Row
        For FRow = 3 To lRow
            lastrow = apws.Cells(apws.Rows.Count, 2).End(xlUp).Row + 1
            If domainws.Cells(FRow, 22) = 0 Or _
               domainws.Cells(FRow, 22) = -5 Then
                apws.Cells(lastrow, 2).Value = domainws.Cells(FRow, 2)
            End If
        Next FRow
    End If
Next domainws
End Sub

这是基于这样的假设：您不想阅读的唯一工作表是

Action Plan

工作表。如果还有其他的，您可以扩展

If domainws.Name <>...

行以排除其他的，或者您可以编写循环以仅读取某些工作表。

此外，虽然您的屏幕抓图建议 3 列在一起，但当您检查 V 列（第 22 列 - 分数）是否包含 0 或 -5，然后复制 B 列（第 2 列 - 参考）的值时，代码会建议其他情况-这是故意的吗？ - 如果不是，请将22更改为正确的列号，例如3？）

Answer 2

如何使Excel主工作表的收据编号中活动的金额栏中的金额，另一工作表中该活动的收据编号中的金额。

主表是这样的 R.无活动量 2024/01 租金 500.00 2024/02 服务 150.00

另一张纸 R 否：租用服务
2024/01 500
2024/02 150