遍历多张工作表，查找特定值，将具有匹配值的单元格粘贴到另一张工作表

Question

我有 5 张表代表一个阶段。每张纸都有一个贯穿始终的唯一 ID。我有一个状态列和一个 for 循环，当状态移动到下一阶段时，它会复制和粘贴行。我正在寻找添加脚本，该脚本将在以前的工作表中搜索唯一 ID，并在该 ID 在每个阶段移动时更新该 ID 的状态列。我尝试使用 if 语句来允许这种情况发生，但它们没有正确更新。这是一个例子：

Private Sub Execute_Click()

a = Worksheets("Execute").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a

    If Worksheets("Execute").Cells(i, 8).Value = "Complete" Then
        Worksheets("Execute").Rows(i).Range("A1:H1").Copy
        Worksheets("Complete").Activate
        b = Worksheets("Complete").Cells(Rows.Count, 1).End(xlUp).Row
        Worksheets("Complete").Cells(b + 1, 1).Select
        Worksheets("Execute").Cells(i, 8).Value = "In Production"
        ActiveSheet.Paste
        Worksheets("Execute").Activate
        
    End If
    
    If Worksheets("Inventory").Cells(i, 3).Value = Worksheets("Execute").Cells(i, 3) Then
    
    Worksheets("Inventory").Cells(i, 8).Value = Worksheets("Execute").Cells(i, 8)

    End If
    
    If Worksheets("Prioritize").Cells(i, 3).Value = Worksheets("Execute").Cells(i, 3) Then
    
    Worksheets("Prioritize").Cells(i, 8).Value = Worksheets("Execute").Cells(i, 8)

    End If
    
    If Worksheets("Score").Cells(i, 3).Value = Worksheets("Execute").Cells(i, 3) Then
    
    Worksheets("Score").Cells(i, 8).Value = Worksheets("Execute").Cells(i, 8)
    
    End If
    
Next

Application.CutCopyMode = False

End Sub

其他信息：

工作簿对于每个选项卡（状态）都将遵循完全相同的过程。行项目由连接列 C 唯一标识 - 工作簿中的每个新项目都将从 Inventory 开始，然后是 Prioritize -> Score -> Execute -> Complete。我为每个状态更改编写了一个 for 循环宏（即，要优先处理的库存、要得分的优先级、要执行的得分、要完成的执行。

for 循环工作正常。当状态从一个阶段更改为下一个阶段时，A:H 中的整行将复制并粘贴到后续选项卡中的下一个可用行。 除了发生这种情况外，我还需要 H 列（状态）来更新之前选项卡上的每个唯一 ID，因为它在各个阶段中移动。

这是一个工作流程示例：

• 第一步：库存中的物品被发送到 Prioritize
• 第二步： A4:H4 从 Inventory 复制并粘贴到 Prioritize - Inventory status updates to Prioritizing
• 第三步： A4:H4 以 Prioritizing 状态粘贴到 Prioritize 中
• 第四步： Prioritize 中的项目发送到 Score
• 第五步： A4:H4 从 Prioritize 中复制并粘贴到 Score - 将状态更新优先于 Scoring
• 第六步：在“优先级”标签中更新为“评分”的行也需要在“库存”标签中更新为“评分”

第六步是我是否遇到了麻烦。这是我编写 If 语句的地方——我正在尝试使用 If 语句来匹配列 C（连接）。例如：如果工作表“执行”中的 C 列与工作表“库存”中的 C 列匹配，则工作表“执行”中的 H 列 = H 列是工作表“库存”。我的代码没有出现任何类型错误，但是当宏运行时，有时状态会在以前的选项卡上正确更新，有时则不会。我想知道是否有更好的方法来更新这些状态？

Answer 1

以相反的顺序遍历工作表并使用Dictionary Object 保存每个唯一 ID 的最后状态。使用该状态更新后面的工作表（早期步骤）。这个单一的脚本将通过所有阶段移动项目。

Option Explicit

Sub UpdateAll()

    Const COL_ID = 3 ' C
    Const COL_PHASE = 8 ' H

    Dim wb As Workbook, ws(5) As Worksheet
    Dim iLast(5) As Long, n As Integer, r As Long
    Dim iMoves As Long, iUpdates As Long
    Dim id As String, status As String
    Dim phase, newstatus
    phase = Array("", "Inventory", "Prioritize", "Score", _
                      "Execute", "Complete")
    newstatus = Array("", "Prioritizing", "Scoring", "Executing", "In Production")

    Dim dict As Object, key
    Set dict = CreateObject("Scripting.Dictionary")
   
    Set wb = ThisWorkbook
    ' step through sheets in reverse order
    For n = 5 To 1 Step -1

        Set ws(n) = wb.Sheets(phase(n))
        iLast(n) = ws(n).Cells(Rows.Count, "A").End(xlUp).Row

        For r = 2 To iLast(n)

            id = Trim(ws(n).Cells(r, COL_ID))
            status = Trim(ws(n).Cells(r, COL_PHASE))

            If n = 5 Then
                 dict.Add id, status
            ElseIf dict.exists(id) Then
                ' seen on earlier sheet - update status
                If ws(n).Cells(r, COL_PHASE) <> dict(id) Then
                    ws(n).Cells(r, COL_PHASE) = dict(id)
                    iUpdates = iUpdates + 1
                End If
            ElseIf LCase(status) = LCase(phase(n + 1)) Then
                'copy to next phase
                iLast(n + 1) = iLast(n + 1) + 1
                ws(n).Cells(r, COL_PHASE) = newstatus(n)
                ws(n).Range("A1:H1").Offset(r - 1).Copy _
                ws(n + 1).Range("A" & iLast(n + 1))
                dict.Add id, newstatus(n)
                iMoves = iMoves + 1
            Else
                ' new - update all previous sheets with this status
                dict.Add id, status
            End If
        Next
    Next
    MsgBox iMoves & " unique ID's moved on" & vbCr & _
           iUpdates & " updated", vbInformation

End Sub