在Excel中使用VBA将基于单元格值的工作表中的数据提取到新工作表中

时间:2020-08-12 13:47:11

标签: excel vba loops

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

Image of the source table

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

Expected results in the Action Plan sheet

我目前有下面的脚本,但是尽管没有任何错误,但除了跳转到源工作表的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
    

作为奖励,我确实需要遍历五个不同的源工作表(所有数据都在同一位置,它们只是具有不同的行数),因此理想情况下希望所有这些工作都在同一循环中发生,但如果需要的话,我也可以复制并调整其他四张纸的循环。

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

1 个答案:

答案 0 :(得分:0)

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

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列- Ref)-是故意的吗? -如果不是,请将22更改为正确的列号,例如3?)

相关问题