在 Excel 中查找重复项，使用最小值更新数据库

Question

`子 Update_data()

Dim Bk1 As Workbook 
Dim Bk2 As Workbook 
Dim Rng1 As Range 

Workbooks("Book1").Activate 'indicate wb name1 here
Set Bk1 = ActiveWorkbook 
Workbooks("Book2").Activate 'indicate wb name2 here
Set Bk2 = ActiveWorkbook 


Bk1.Activate 
Set Rng1 = Range(Cells(1, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 2)) 

Rng1.Copy 
Cells(1, 26).PasteSpecial Paste:=xlPasteValues 
Cells(1, 26).AutoFilter 
ActiveWorkbook.ActiveSheet.AutoFilter.Sort.SortFields.Add Key:=Rng1.Offset(0, 25), SortOn:=xlSortOnValues, Order:=xlAscending 
Cells(1, 26).AutoFilter 

Rng1.Offset(0, 25).RemoveDuplicates Columns:=1, Header:=xlYes 
Rng1.Offset(1, 25).NumberFormat = "m/d/yyyy" 

Dim i As Integer 

For i = 2 To Cells(Rows.Count, 26).End(xlUp).Row 
    Dim x As String 
    x = Cells(i, 26).Value 
    Bk2.Activate 
    Dim y As Integer 
    On Error Resume Next 
    y = WorksheetFunction.Match(x, Bk2.Worksheets(1).Columns(1)) 
    Bk2.Worksheets(1).Cells(y, 2) = Bk1.Worksheets(1).Cells(i, 27) 

    Bk1.Activate 
Next i 

Rng1.Offset(0, 25).ClearContents`

请帮助我使用 VBA 宏来实现以下目标。

我有两个工作簿 - 工作簿 1 和工作簿 2

WB 1 是输入数据的地方。WB 2 是数据库。（此 WB 中没有重复项）

从 WB1 中，如果 A 列中有重复项，则检查 B 列中的对应值是否是重复项中的最小值。

然后复制相应的 A 和 B 单元格（其中 B 具有最小值）以及 A 和 B 列中的其他数据，并将 WB1 的 A 列与 WB 2 的 A 列进行匹配，如果找到匹配，则将在 WB1 的 B 列中找到的重复项中的最小值以及 WB1 中 A 和 B 列中的其他原始数据粘贴到 WB2 的 B 列中。

我能够使用 MAX 创建的附加代码实现上述功能，

但在测试时发现了一个小错误。如果 WB 2（数据库）按升序排列，则宏可以正常工作，但如果 WB2（数据库）没有按顺序排列或杂乱无章，则 WB 2 的 B 列中的某些单元格将留空。

我还尝试在 WB1（数据捕获列 A）中输入不带任何重复的数据，但它在 WB 2 中返回了错误的数据（日期 - 列 B）

我已附加示例图像供您审阅。

[https://www.dropbox.com/s/0vq76uvzs2rav3q/NIHL%20data%20Capturesample.xls?dl=0]

Answer 1

正如@teylyn 在评论中解释的那样，我们不是代码编写服务。此外，你的代码很乱。我会尝试给你一些提示，并希望鼓励你自己重写代码。

• Dim用于声明变量。将所有Dim语句放在顶部。
• 尝试理解你的代码的作用，并删除所有重复/无功能/重复的代码

• 阅读您使用的函数的 Microsoft Technet 文档。对于该Match函数，它明确指出：

  “MATCH 函数将查找小于或等于值的最大值。您应该确保按升序对数组进行排序。”

• 在代码的每个部分（每 3 到 8 行代码）上方添加一些注释，解释其作用。

• 不要使用.Activate在工作簿之间切换。由于您已定义两个Workbook对象，因此您可以通过 访问工作表中的数据WorkbookObject.Range(<etc.>)。这使得您的代码很多速度更快，并且它隐藏了按下按钮的用户的工作簿切换。