使用 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 列 - Ref） -這是故意的嗎？ - 如果不是，請將 22 更改為正確的列號，例如 3？）