点击button后合并两个电子表格

我有2个电子表格：

main.xlsxm

drs.xlsx

我试图合并这两个电子表格 – 这个事件将在main.xlsx电子表格上点击button后启动（因此VBA代码将驻留在main.xlsx中）。

但是我在编写代码时遇到了困难，我最初尝试使用以下Excel公式的变体，但速度非常慢。

= IFERROR（INDEX（[1.xlsx] Sheet 1中$ A：$ A，SMALL（IF（[1.xlsx] Sheet 1中$ B：$ B = $ A2，ROW（[1.xlsx] Sheet 1中$ B！ $ B），99 ^ 99），COLUMN（A $ 1）））， “”）

我正试图在VBA中完成以下内容：

如果drs.xlsx中的 列值E等于main.xlsx中的 列值A ：则在main.xlsx中的匹配行上将drs.xls中的 列值B复制到main.xlsx中的列值J

如果find第二个匹配项（只要它与第一个匹配项不相同）： drs.xlsx中的 列值E等于main.xlsx中的 列值A将 drs.xls中的 列值B复制到main中的列值K. XLSX

如果find了第三个匹配项（假设它与第一个和第二个匹配项不相同）： drs.xlsx中的 列值E等于main.xlsx中的 列值A将 drs.xls中的 列值B 复制到列值L中main.xlsx

如果它发生了第四次，然后忽略…

我怎样才能把这个expression为VBA代码？

这是我的代码（准备电子表格准备就绪）：

Sub DRS_Update() Dim wb As Workbook Set wb = Workbooks.Open("C:\drs.xlsx") With wb.Worksheets("Sheet1") .AutoFilterMode = False With .Range("A1:D1") .AutoFilter Field:=1, Criteria1:="TW", Operator:=xlOr, Criteria2:="W" .AutoFilter Field:=3, Criteria1:="Windows 7", Operator:=xlOr, Criteria2:="Windows XP" .AutoFilter Field:=4, Criteria1:="Workstation-Windows" End With End With End Sub 

Answer 1

尝试下面的代码。 我已经详细地评论过了，但是如果你有一些问题，请随时提问:)

 Sub test() Dim wb As Workbook Dim sh1 As Worksheet Dim sh2 As Worksheet Dim user As Range Dim lastrowDRS As Long, lastrowMAIN As Long Dim rng As Range, res As Range Dim k As Byte Dim fAddr As String Application.ScreenUpdating = False 'specify sheet name for main workbook Set sh1 = ThisWorkbook.Worksheets("Sheet1") 'if drs is already opened 'Set wb = Workbooks("drs.xlsx") 'if drs not already opened Set wb = Workbooks.Open("C:\drs.xlsx") 'specify sheet name for drs workbook Set sh2 = wb.Worksheets("Sheet1") With sh1 'find last row on column A in main wb lastrowMAIN = .Cells(.Rows.Count, "A").End(xlUp).Row 'clear prev data in columns J:L .Range("J1:L" & lastrowMAIN).ClearContents End With With sh2 .AutoFilterMode = False 'find last row on column A in drs wb lastrowDRS = .Cells(.Rows.Count, "A").End(xlUp).Row 'apply filter With .Range("A1:D1") .AutoFilter Field:=1, Criteria1:="TW", Operator:=xlOr, Criteria2:="W" .AutoFilter Field:=3, Criteria1:="Windows 7", Operator:=xlOr, Criteria2:="Windows XP" .AutoFilter Field:=4, Criteria1:="Workstation-Windows" End With On Error Resume Next 'get only visible rows in column E Set rng = .Range("E1:E" & lastrowDRS).SpecialCells(xlCellTypeVisible) On Error GoTo 0 'loop throught each user in main wb For Each user In sh1.Range("A1:A" & lastrowMAIN) 'counter for finding entries k = 0 'find first match Set res = rng.Find(what:=user.Value, MatchCase:=False) If Not res Is Nothing Then 'remember address of first match fAddr = res.Address Do 'user.Offset(, 9 + k) gives you column J for k=0, K for k=1, L for k=2 user.Offset(, 9 + k).Value = res.Offset(, -3).Value 'increment k k = k + 1 'find next match Set res = rng.FindNext(res) 'if nothing found exit stop searcing entries for current user If res Is Nothing Then Exit Do 'if we already found 3 mathes, then stop search for current user Loop While fAddr <> res.Address And k < 3 End If Next user End With 'close drs wb without saving changes wb.Close saveChanges:=False Set wb = Nothing Application.ScreenUpdating = True End Sub