我正在努力创建一个处理从另一个打开的工作簿中检索数据的数据库代码。我有一个主要的工作簿,其上的数据是手动从辅助工作簿中馈送。我希望用一个将位于Personal. XLSB中的宏来自动化这一点。我对数据库很陌生,我正在学习如何解决所有这些问题。
E列(test 5)为匹配条件,如果主工作簿中的E列与辅助工作簿中的E列匹配,则复制单元格D;F;G;H;I; J从辅助工作簿到主工作簿。如果在E列中没有匹配项,则对该行没有任何操作,它需要转到下一行,直到找到匹配项。我已经设法编写了一段代码,但它崩溃了,因为有超过1 k行要匹配。然后我尝试了其他方法(见下文)
主要工作簿
x1c 0d1x的数据
辅助工作簿
的
这是我正在做的代码,但我放弃了,因为我不明白它。这只是一个烂摊子
Option Explicit
Sub WithButton()
Dim KeyCells As Range
Dim sh_Data As Worksheet '
Dim CellChanged As Integer
Dim LastRow, LastData As Long
Dim Found As Boolean
Dim wb2 As Workbook '
On Error GoTo Handle
With Sh_Record
If .Range("Z1").Value = "" Then
.Range("Z1").Value = 0
CellChanged = .Cells(Rows.Count, "E").End(xlUp).Row
End If
If .Cells(Rows.Count, "E").End(xlUp).Row > .Range("Z1").Value Then
Set wb2 = Workbooks.Open("C:\Users\User\Desktop\Second.xlsx")
Set sh_Data = wb2.Worksheets("data")
CellChanged = .Range("Z1").Value + 1
LastRow = sh_Data.Cells(Rows.Count, "E").End(xlUp).Row
LastData = .Cells(Rows.Count, "E").End(xlUp).Row
For i = 1 To LastRow
If .Range("E" & CellChanged).Value = sh_Data.Range("E" & i) Then
.Range("D" & CellChanged).Value = sh_Data.Range("D" & i).Value
.Range("F" & CellChanged).Resize(, 5).Value = sh_Data.Range("F" & i).Resize(, 5).Value
Found = True
End If
If Found = True Or i = LastRow Then
If CellChanged = LastData Then
Exit For
End If
If Found = True Then
Found = False
CellChanged = CellChanged + 1
Else
CellChanged = CellChanged + 1
End If
i = 0
End If
Next i
wb2.Close False
.Range("Z1").Value = CellChanged
End If
End With
Exit Sub
Handle:
MsgBox ("Error")
End Sub
字符串
1条答案
按热度按时间9rygscc11#
Dictionary
对象是获取唯一列表和比较数据的更有效方法。字符串
Dictionary object
更新
问题:我希望创建一个规则,如果主工作簿中已经有值,则不从辅助WB复制值。
型