我有兩本作業簿，一本名為“LocalBooks”，另一本名為“CentralIndex”。“LocalBooks”表中的所有條目都有唯一的參考編號。我正在嘗試撰寫一些內容，用匹配的參考號在“CentralIndex”中查找一行，然后更新該行中的特定列。（我知道匹配并更新整行是一個常見問題，但我找不到它只是為了更新行中的特定列）
作業簿：“Localbooks” - 請假設第一個單元格地址是 A1，作業表名稱是書籍
作業簿：“CentralIndex” - 請假設第一個單元格地址是 A1，作業表名稱是 Central Index
如果我的代碼運行正確，我希望“中央索引”看起來像這樣：
更新了第 2 (C2,E2,I2)、6 (C6,E6,I6) 和 10 行。
注意事項/限制
以上是我的任務的樣本表，因為我無法共享實際資料，但實際資料集看起來超過 200 行。
“中央索引”表中不會有任何重復的參考編號。所以多次匹配不是問題。
我確實考慮過使用陣列，但一直堅持保存“書籍”中的多列值，然后將它們放在不同的列中。如果有辦法做到這一點，那么我歡迎它。
我不能使用經典的索引/匹配或其他公式解決方案，因為要求是“按按鈕進行更新”，我無法修改“中央索引”表。
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....
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 :)
uj5u.com熱心網友回復：
使用以參考號作為鍵和相應的索引表行號作為值的字典物件。
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
uj5u.com熱心網友回復：
如果您想在 vba 中執行此操作，您應該使用“字典”。例如，運行時“6”溢位錯誤 - 用于股票分析的重構代碼
但根據您的描述，我建議使用“Powerquery”。在您的“CentralIndex”作業簿中：
- 轉到選單資料 > 獲取資料 > 從檔案 > 從作業簿 => 選擇“Localbooks.xlsx”并選擇要加載的作業表
- 點擊“轉換資料”
- 在左上角你會看到“關閉并加載”按鈕，確保點擊小三角形并選擇“關閉并加載到”，檢查：僅連接。
- 轉到“CentralIndex”中的作業表，單擊單元格 A1
- 轉到選單資料>單擊“從表格范圍”并選中“我的表格有標題”
如果一切順利，您將回傳到 powerquery 并且您有 2 個查詢（如果您沒有看到它們，請單擊左側）。匹配：
- 選擇其中1個，點擊您要匹配的列
- 在選單“主頁”>“合并查詢”=> 選擇要匹配的第二個表和列，將 joinKind 留在左側并點擊確定。
- 您應該會看到一個帶有 dubbel 箭頭的新列，單擊箭頭并選擇要添加的列。
- 點擊選單“關閉并加載”，這次選擇第一個選項并加載到新作業表
讓我知道它是怎么回事，或者你是否被卡住了。
轉載請註明出處，本文鏈接：https://www.uj5u.com/net/335704.html