VBA - 搜索和删除重复项

VBA - Search and remove duplicates

提问by qwerty_face

I'm looking for an algorithm for which I do not have the VBA knowledge to script myself. So I'm stuck. It isn't through lack of effort trying because I have given it a go (plus, this bit of code is the last remaining piece of my bigger VBA code) I simply lack the knowledge/experience/skill...

我正在寻找一种我没有 VBA 知识来编写脚本的算法。所以我被困住了。这不是因为我已经尝试过而缺乏努力（另外，这段代码是我更大的 VBA 代码的最后一部分）我只是缺乏知识/经验/技能......

Basically, I have an Excel file. In this file is a sheet, "sheet1". Sheet1 contains many rows of data. The number of rows contained in sheet1 can vary from 1 to n. Sometimes, I may have 50 while other times I may have 30, etc. What is consistent is the layout of the book, i.e. I have codes in column A which identify a product in my database.

基本上，我有一个 Excel 文件。在这个文件中是一张工作表，“sheet1”。Sheet1 包含多行数据。sheet1 中包含的行数可以在 1 到 n 之间变化。有时，我可能有 50 个，而有时我可能有 30 个，等等。一致的是书的布局​​，即我在 A 列中有代码，用于标识我的数据库中的产品。

What I want to do is this:

我想做的是这样的：

1.Scan the sheet for empty rows (due to the way the workbook is generated, I sometimes have blank rows) and remove them. These blank rows are sometimes in-between rows with data while at other times may be trailing at the end of the sheet.

1.扫描工作表中的空行（由于工作簿的生成方式，我有时会有空行）并删除它们。这些空白行有时位于包含数据的行之间，而有时可能位于工作表的末尾。

2.After removing the blank rows find the last used row. Store that to a variable. I have found this piece of code useful for doing that:

2.删除空白行后，找到最后使用的行。将其存储到变量中。我发现这段代码对这样做很有用：

mylastrow = myBook.Sheets("Results").Cells.Find(what:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

mylastrow = myBook.Sheets("Results").Cells.Find(what:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

3.Starting from the row determined in (2), I want to take the product code in A(x where x = mylastrow) and find any other occurrences of it (in column A). If any are found, delete that entire row corresponding to it. Importantly, this loop must go in reverse. For example let's say mylastrow = 40, the loop will need to begin at A40 and on the next iteration do A39 (or 38 if a row has been removed?). This is because with any of the product numbers the corresponding data in the row contains more data further down the column (because of the way the sheet was generated). Essentially the entry closest to the last row is the most recent.

3.从 (2) 中确定的行开始，我想取 A(x where x = mylastrow) 中的产品代码并找到它的任何其他出现（在 A 列中）。如果找到，则删除与其对应的整行。重要的是，这个循环必须反向进行。例如，假设mylastrow = 40循环需要从 A40 开始，并在下一次迭代中执行 A39（如果行已被删除，则为 38？）。这是因为对于任何产品编号，行中的相应数据在列的下方包含更多数据（因为工作表的生成方式）。本质上，最接近最后一行的条目是最新的。

Hopefully I've been able to explain the situ properly. But if not and you're willing to take the challenge (my burden?) off me I would be very grateful.

希望我已经能够正确解释现场。但是，如果没有，并且您愿意接受挑战（我的负担？），我将不胜感激。

QF

资格认证

回答by Zairja

The only way to develop that knowledge and skill is to get in there and code! I'm sure someone may come in and write you the entire procedure, but in the meantime these resources should give you the tools to do it yourself.

发展这些知识和技能的唯一方法是进入那里并编写代码！我敢肯定有人会进来给你写整个过程，但与此同时，这些资源应该给你提供自己做的工具。

First, check out the method hereto delete blank rows. It relies on "Selection" for the range, so you can either manually select all the cells of the sheet, then run the macro, or replace it with the following:

首先，查看此处删除空白行的方法。它依赖于范围的“选择”，因此您可以手动选择工作表的所有单元格，然后运行宏，或将其替换为以下内容：

Dim r as range
set r = Sheet1.Cells 'now use r instead of Selection

OR (even better) use your code for finding the last used row and set the range from row 1 to "mylastrow".

或者（甚至更好）使用您的代码查找最后使用的行并将第 1 行的范围设置为“mylastrow”。

Next, beginning from "mylastrow", start adding the values in Column A to a Dictionary object (example here). You can use a row counter to decrement from "mylastrow" to 1. Here's an example of how it would work. The key is assumed to be in the 1st column ("A").

接下来，从“mylastrow”开始，开始将 A 列中的值添加到 Dictionary 对象（此处的示例）。您可以使用行计数器将“mylastrow”递减到 1。这是一个如何工作的示例。假定键位于第一列（“A”）中。

Dim dict As Object
Dim rowCount As Long
Dim strVal As String

Set dict = CreateObject("Scripting.Dictionary")

rowCount = Sheet1.Range("A1").CurrentRegion.Rows.Count

Do While rowCount > 1
  strVal = Sheet1.Cells(rowCount, 1).Value2

  If dict.exists(strVal) Then
    Sheet1.Rows(rowCount).EntireRow.Delete
  Else
    dict.Add strVal, 0
  End If

  rowCount = rowCount - 1
Loop

Set dict = Nothing

Before: After:

之前： 之后：

Note that the 1st row hasn't been touched since we stopped when rowCountis 1 (assumes there's a header).

请注意，自从我们在rowCount1时停止（假设有一个标题）以来，第一行没有被触及。