excel - 遍历多张工作表,查找特定值,将具有匹配值的单元格粘贴到另一张工作表
问题描述
我有 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 粘贴到 Prioritize 中,状态为 Prioritizing
- 第四步: Prioritize 中的项目发送到 Score
- 第五步: A4:H4 从 Prioritize 复制并粘贴到 Score - Prioritize status updates to Scoring
- 第六步:在 Prioritize 选项卡中更新为 Scoring 的行也需要在 Inventory 选项卡中更新为 Scoring
第六步是我遇到麻烦了。这是我编写 If 语句的地方——我正在尝试使用 If 语句来匹配列 C(连接)。例如:如果工作表“执行”中的 C 列与工作表“库存”中的 C 列匹配,则工作表“执行”中的 H 列 = H 列是工作表“库存”。我的代码没有出现任何类型错误,但是当宏运行时,有时状态会在以前的选项卡上正确更新,有时则不会。我想知道是否有更好的方法来更新这些状态?
解决方案
以相反的顺序遍历工作表并使用字典对象来保存每个唯一 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
推荐阅读
- sql - EF Core 5 + Sql Server:慢查询
- git - 如何设置提交同一回购的竹子分解?
- java - 将sql数据库中的值存储到java中的变量
- r - Dplyr:case_when - 如何使用来选择一列?
- python - 无法在 json python 中删除不需要的字符
- r - 如何使用 r shiny 中的切换开关将 scales="free_y" 添加到构面?
- ruby-on-rails - ActionView::Template::Error (Webpacker 找不到转换 .../public/packs/manifest.json
- spring-boot - 设置显式版本后 Jooq-codegen 降级
- c++ - 如何设置 hair_mesh 跟随动画?
- mysql - 我无法连接到托管在 RDS 上的 MariaDB 服务器