[英]Find match within a column in a different worksheet, then copy paste specific cells to matched row in VBA
I've got two workbooks, one named "LocalBooks" and another named "CentralIndex".我有两本工作簿,一本名为“LocalBooks”,另一本名为“CentralIndex”。 All of the entries in the sheet "LocalBooks" have a unique reference number.
“LocalBooks”表中的所有条目都有唯一的参考编号。 I'm trying to write something that looks for a row in "CentralIndex" with that matching reference number and then updates specific columns in that row.
我正在尝试编写一些内容,用匹配的参考号在“CentralIndex”中查找一行,然后更新该行中的特定列。 (I do understand that a match and update entire row is a commonly asked question, but I couldn't find it for just updating specific columns in the row)
(我知道匹配和更新整行是一个常见问题,但我找不到它只是为了更新行中的特定列)
Workbook: "Localbooks" - Please assume first cell address is A1, sheet name is books工作簿:“Localbooks” - 请假设第一个单元格地址是 A1,工作表名称是书籍
Workbook: "CentralIndex" - Please assume first cell address is A1, sheet name is Central Index工作簿:“CentralIndex” - 请假设第一个单元格地址是 A1,工作表名称是 Central Index
If my code runs correctly I'd like the "Central Index" to look like this:如果我的代码运行正确,我希望“中央索引”看起来像这样:
With rows 2 (C2,E2,I2), 6 (C6,E6,I6) and 10 updated.
更新了第 2 (C2,E2,I2)、6 (C6,E6,I6) 和 10 行。
Considerations/Constraints注意事项/限制
The above are sample sheets for my task, as I'm unable to share the actual data, but the actual sets are looking over 200+ rows.以上是我的任务的样本表,因为我无法共享实际数据,但实际数据集看起来超过 200 行。
There won't be any duplicate reference numbers in the "Central Index" sheet. “中央索引”表中不会有任何重复的参考编号。 So multiple matches aren't an issue.
所以多次匹配不是问题。
I did contemplate using an array, but got stuck on holding the multiple column values from "Books" and then putting them in the different columns.我确实考虑过使用数组,但一直坚持保存“书籍”中的多列值,然后将它们放在不同的列中。 If there is a way to do that then I welcome it.
如果有办法做到这一点,那么我欢迎它。
I cannot use a classic index/match or other formula solution as the ask is to "Make update with press button" and I cannot amend the "central index" sheet.我不能使用经典的索引/匹配或其他公式解决方案,因为要求是“按按钮进行更新”,我无法修改“中央索引”表。
In a very ideal world, I'd love for the code to also highlight any rows in "Local Books" that were not matched in the "Central Index".在一个非常理想的世界中,我希望代码还能突出显示“本地图书”中与“中央索引”不匹配的任何行。 But as my code is very not working I hadn't got that far.
但由于我的代码非常不工作,我还没有走那么远。
My code below uses the match function to find the row address, however when I go to run it, nothing seems to happen....我下面的代码使用 match 函数来查找行地址,但是当我去运行它时,似乎什么也没发生....
Sub Update()
Dim wbLocal As Workbook
Dim wbCentral As Workbook
Dim wsBooks As Worksheet
Dim wsCentral As Worksheet
Dim lrBooks As Long
Dim lrCentral As Long
Dim i As Long
Dim rc As Variant
Set wbLocal = Workbooks("LocalBooks.xlsx")
Set wbCentral = Workbooks("CentralIndex.xlsx")
Set wsBooks = wbLocal.Worksheets("Books")
Set wsCentral = wbCentral.Worksheets("Central Index")
lrBooks = wsBooks.Cells(wsBooks.Rows.Count, 1).End(xlUp).Row
lrCentral = wsCentral.Cells(wsCentral.Rows.Count, 1).End(xlUp).Row
For i = 2 To lrCentral
rc = Application.Match(wsCentral.Cells(i, 1).Value, wsBooks.Range("A1:A" & lrBooks), 0)
If Not IsError(rc) Then
wsBooks.Range("D").Select
Selection.Copy
Windows("CentralIndex.xlsx").Activate
wsCentral.Range("C").Select
ActiveSheet.Paste
Windows("LocalBooks.xlsx").Activate
End If
Next
End Sub
Debugging doesn't seem to pick anything up, so I haven't even been able to see if the copy paste part works either.调试似乎没有任何结果,所以我什至无法看到复制粘贴部分是否有效。 (I'm aware that the current iteration of the copy paste won't get me the results above, I just wanted to see if what I'd done worked before using it for the other cells).
(我知道复制粘贴的当前迭代不会让我得到上面的结果,我只是想看看在将它用于其他单元格之前我所做的工作是否有效)。
Happy to provide more info, and a giant thanks in advance.很高兴提供更多信息,并提前致谢。 Promise I am learning so much from each question I ask :)
保证我从我提出的每个问题中学到了很多:)
Using a Dictionary Object with reference numbers as keys and corresponding Index sheet row numbers as values.使用以参考号作为键和相应的索引表行号作为值的字典对象。
Option Explicit
Sub Update()
Dim wbLocal As Workbook, wbCentral As Workbook
Dim wsBooks As Worksheet, wsCentral As Worksheet
Dim lrBooks As Long, lrCentral As Long
Dim i As Long, r As Long, rc As Variant
Dim n As Long, m As Long
Dim dict As Object, key As String
Set dict = CreateObject("Scripting.Dictionary")
Set wbLocal = Workbooks("LocalBooks.xlsx")
Set wbCentral = Workbooks("CentralIndex.xlsx")
Set wsBooks = wbLocal.Worksheets("Books")
Set wsCentral = wbCentral.Worksheets("Central Index")
' build lookup
With wsCentral
lrCentral = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = 2 To lrCentral
key = Trim(.Cells(i, "B"))
If dict.exists(key) Then
MsgBox "Duplicate Ref No '" & key & "'", vbCritical, "Row " & i
Exit Sub
ElseIf Len(key) > 0 Then
dict.Add key, i
End If
Next
End With
' scan books, match ref numbers and update index
With wsBooks
lrBooks = .Cells(.Rows.Count, "A").End(xlUp).Row
For i = 2 To lrBooks
key = Trim(.Cells(i, "A"))
If dict.exists(key) Then
r = dict(key)
wsCentral.Cells(r, "C") = .Cells(i, "D") ' Status
wsCentral.Cells(r, "E") = .Cells(i, "E") ' Date last loaned
wsCentral.Cells(r, "I") = .Cells(i, "H") ' Currently loaned to
n = n + 1
Else
.Rows(i).Interior.Color = RGB(255, 255, 0)
m = m + 1
End If
Next
End With
MsgBox n & " records updated" & vbLf & m & " rows not found", vbInformation
End Sub
If you want to do this in vba you should use a "dictionary".如果您想在 vba 中执行此操作,您应该使用“字典”。 eg Runtime '6' Overflow Error - Refactoring Code for Stock Analysis
例如, 运行时“6”溢出错误 - 用于股票分析的重构代码
But based on your description I would recommend to use "Powerquery".但根据您的描述,我建议使用“Powerquery”。 In your "CentralIndex" workbook:
在您的“CentralIndex”工作簿中:
If all went well, you are back in powerquery and you have 2 queries (click on the left if you don't see them).如果一切顺利,您将返回到 powerquery 并且您有 2 个查询(如果您没有看到它们,请单击左侧)。 To match:
匹配:
Let me know how it goes or if you get stuck.让我知道它是怎么回事,或者你是否被卡住了。
声明:本站的技术帖子网页,遵循CC BY-SA 4.0协议,如果您需要转载,请注明本站网址或者原文地址。任何问题请咨询:yoyou2525@163.com.