天道酬勤,学无止境

VBA - 搜索和删除重复项(VBA - Search and remove duplicates)

问题

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

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

我想做的是:

1.扫描工作表中的空行(由于工作簿的生成方式,我有时会有空行)并将其删除。 这些空白行有时位于数据行之间,而有时可能位于工作表末尾。

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

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

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

希望我能够正确解释现场。 但如果不是,并且您愿意接受挑战(我的负担?),我将非常感激。

资历架构

回答1

发展这些知识和技能的唯一方法是进入那里并编写代码! 我相信有人可能会进来并为您编写整个过程,但与此同时,这些资源应该为您提供自己完成的工具。

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

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

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

接下来,从“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

前:前 后:后

请注意,自从我们在rowCount为 1 时停止(假设有一个标题)以来,第一行没有被触及。

受限制的 HTML

  • 允许的HTML标签:<a href hreflang> <em> <strong> <cite> <blockquote cite> <code> <ul type> <ol start type> <li> <dl> <dt> <dd> <h2 id> <h3 id> <h4 id> <h5 id> <h6 id>
  • 自动断行和分段。
  • 网页和电子邮件地址自动转换为链接。

相关推荐
  • 使用VBA从阵列中删除重复项(Remove duplicates from array using VBA)
    问题 假设我在Excel 2010中有一块数据,每行100列,每列3列。 C列包含一些重复项,说它开始于 1,1,1,2,3,4,5,.....,97,98 使用VBA,我想删除重复的行,所以剩下98行和3列。 1,2,3,.....,97,98 我知道Excel 2010中有一个按钮可以执行此操作,但是此操作随后会干扰我的其余代码并给出错误的结果。 此外,我想将其放入数组中,然后将结果粘贴到工作表上,而不是将诸如Application.Worksheetfunction.countif(..... 所以像这样: Dim myarray() as Variant myarray=cells(1,1).Currentregion.value Dim a as Long For a=1 to Ubound(myarray,1) 'something here to Next a 回答1 我回答了类似的问题。 这是我使用的代码: Dim dict As Object Dim rowCount As Long Dim strVal As String Set dict = CreateObject("Scripting.Dictionary") rowCount = Sheet1.Range("A1").CurrentRegion.Rows.Count 'you can change
  • 在vba中使用数组进行重复删除[重复](Duplicate Removal using an array in vba [duplicate])
    问题 这个问题在这里已经有了答案: 如何快速删除两个 Excel 工作表之间的重复项 vba (2 个回答) 5年前关闭。 嗨,我使用了一个问题“如何快速删除两个 Excel 表格之间的重复项 vba”的答案中的一些代码,并尝试更改此代码以适应我自己的 VBA 脚本。 该代码确实删除了与数组中相同数量的行,但它只是删除了前 11 行。 我对 VBA 相当陌生,并不完全理解它为什么这样做。 下面是我正在使用的脚本的副本。 Dim overLayWB As Workbook 'Overlay_workbook Dim formattedWB As Workbook 'Formatted_workbook Dim formattedWS As Worksheet 'Current active worksheet (Formatted) Dim overLayWS As Worksheet 'Worksheet in OverLay Dim lastRowFormatted As Long Dim lastRowOverLay As Long Dim targetArray, searchArray Dim targetRange As Range Dim x As Long 'Update these 4 lines if your target and search ranges
  • 用于删除另一个选项卡中特定列中的重复项的 VBA(VBA for removing duplicates in a specific column in another tab)
    问题 这是简单 VBA 的一个简单问题,但我无法通过多次搜索找到答案。 我希望能够通过按下分配给工作簿 1 中宏的按钮来删除工作簿工作簿 2 中 A 列中的重复项。 这是我分配给第 1 表中按钮的代码: Sub RemoveDupes() Sheets("Sheet2").Range("A1:A10350").RemoveDuplicates End Sub 这段代码似乎只是尝试删除按钮所在列或我单击的任何工作表中的任何列中的重复项。 如何指定删除工作表 2 中 A 列中的重复项?
  • 用于比较 2 个工作表并删除重复单元格的 VBA 脚本“大搜索范围”(VBA script to compare 2 sheets and delete duplicated cells “Big Search Range”)
    问题 我想要一个脚本,将“工作表 1 单元格”与“工作表 2 单元格”进行比较并从工作表 2 中删除重复项。我现在正在使用此脚本 Option Explicit Sub CleanDupes() Dim targetArray, searchArray Dim targetRange As Range Dim x As Long 'Update these 4 lines if your target and search ranges change Dim TargetSheetName As String: TargetSheetName = "Sheet2" Dim TargetSheetColumn As String: TargetSheetColumn = "A" Dim SearchSheetName As String: SearchSheetName = "Sheet1" Dim SearchSheetColumn As String: SearchSheetColumn = "A" 'Load target array With Sheets(TargetSheetName) Set targetRange = .Range(.Range(TargetSheetColumn & "1"), _ .Range(TargetSheetColumn & Rows
  • VBA:从集合中删除重复项[重复](VBA: Removing duplicates from a Collection [duplicate])
    问题 这个问题在这里已经有了答案: vba:从数组中获取唯一值(10 个回答) 4年前关闭。 我想要完成的事情 我想从一组单元格中获取一系列值,然后填充一个新单元格,其中仅包含我所做的选择中的唯一值。 到目前为止,这是我的代码: Const Delimiter = ", " Dim num As Range Dim a As Variant Dim Concat, bucket As New Collection #to create a collection that contains all the values from my selection For Each num In Selection a = Split(num, Delimiter) Concat.Add (a) Next num #to convert multidimensional collection to a single dimensional For i = 1 To Concat.Count For j = 1 To Concat(i).Count bucket.add(Concat(i)(j)) Next i Next j #to remove duplicate values [code] #to output to excel [code] 如您所见,代码不完整。 我遇到以下代码行问题
  • 用条件删除重复项的 VBA 代码(VBA code to remove duplicates with condition)
    问题 我在工作表 1 的 A 到 L 列中有一些数据 我想删除 L 列中没有数据的 F 列中的重复 ID,或者如果所有重复项中都存在数据,则保留任意 1。 我想将数据返回到工作表 2 例子: A B C D E ColumnF G H I J K ColumnL 1 00:20:21 1 00:20:21 2 2 2 00:00:20 应该返回 1 00:20:21 2 00:00:20 回答1 它必须是VBA吗? 我会这样做: 按列 F 和 L 对数据进行排序。在单元格 M2 中输入以下公式: =IF(AND(L2=L1,F2=F1),"","X") 然后过滤您的数据,其中列 M 等于“X”或按列 M 排序,然后您将拥有非重复项,您可以将其复制并粘贴到新位置。 回答2 在这里,我解决您的问题的方法: Public Sub removeDuplicate() Dim row, innerRow, resultRow, index As Integer 'Create array for no of data row in Sheet1 Dim finishedRow(10) As String row = 1 resultRow = 1 index = 1 With Sheets("Sheet1") 'Loop until ID cell is blank Do While
  • 删除 Excel 单元格中的重复项(Remove duplicates within Excel cell)
    问题 假设我在一个 Excel 单元格中有以下文本字符串: John John John Mary Mary 我想在另一个单元格上创建一个公式(所以没有菜单功能或 VBA,请) John Mary 我怎样才能做到这一点? 到目前为止,我所尝试的是在互联网上搜索有关该问题的 SO,我所能找到的只是涉及 Excel 的内置重复删除或涉及countif和替换""重复项的解决方案。 我还查看了 Excel 函数列表,尤其是“文本”类别中的函数列表,但找不到任何可以在一个单元格上完成的有趣内容。 回答1 答案在这里:https://www.extendoffice.com/documents/excel/2133-excel-remove-duplicate-characters-in-string.html Function RemoveDupes2(txt As String, Optional delim As String = " ") As String Dim x 'Updateby20140924 With CreateObject("Scripting.Dictionary") .CompareMode = vbTextCompare For Each x In Split(txt, delim) If Trim(x) <> "" And Not .exists(Trim(x
  • 从Excel VBA中的单元格区域中删除重复项(Remove Duplicates from range of cells in excel vba)
    问题 我正在尝试在excel 2013 VBA中删除重复项。 但出现错误“对象不支持此属性或方法”。 问题是我没有静态范围可供选择。 我想从列heaader'abcd'中删除重复项。 Cells.Find(what:="abcd").Activate ActiveCell.EntireColumn.Select Set rng = Selection ActiveSheet.rng.RemoveDuplicates 回答1 您需要告诉Range.RemoveDuplicates方法使用哪个列。 另外,由于您已经表示自己有标题行,因此应该告诉.RemoveDuplicates方法。 Sub dedupe_abcd() Dim icol As Long With Sheets("Sheet1") '<-set this worksheet reference properly! icol = Application.Match("abcd", .Rows(1), 0) With .Cells(1, 1).CurrentRegion .RemoveDuplicates Columns:=icol, Header:=xlYes End With End With End Sub 您的原始代码似乎想从单个列中删除重复项,而忽略周围的数据。 这种情况是非典型的,并且我包括了周围的数据,因此
  • 运行 VBA 字符串以删除唯一重复项时出现运行时错误(Run Time Error when running a VBA string to remove unique duplicates)
    问题 所以我最初询问如何根据区分大小写删除唯一重复项(请参阅下面的链接:Excel:根据区分大小写删除重复项 最终我被引导到以下链接: 如何删除 Excel 中区分大小写的重复项(对于 100k 记录或更多)? 这次我使用列 q 来测试公式,到目前为止,以下公式有效: Sub duptest() Sheets("Analysis").Select Dim x, dict Dim lr As Long lr = Cells(Rows.Count, 1).End(xlUp).Row x = Range("Q1:Q100000" & lr).Value Set dict = CreateObject("Scripting.Dictionary") For i = 1 To UBound(x, 1) dict.Item(x(i, 1)) = "" Next i Range("Q1:Q100000" & lr).ClearContents Range("Q1").Resize(dict.Count).Value = Application.Transpose(dict.keys) End Sub 但是,我的问题是,我希望范围是整个 Q 列,但是在进行以下更改时: Sub duptest() Sheets("Analysis").Select Dim x, dict Dim lr As
  • Excel - VBA 从组合框中删除重复项(Excel - VBA Removing Duplicates from Comboboxes)
    问题 我正在尝试创建一个子程序来删除组合框中的重复项。 当我调用子程序时,我输入了一个数字来代替 X。 当我到达子例程时,我不断收到一个错误,告诉我“需要对象”。 我知道这意味着某些东西没有被正确初始化,但我不知道如何解决我的问题。 任何帮助将不胜感激。 谢谢你。 Private Sub UserForm_Initialize() 'ComboBox Populate Dim rngNext As Range Dim myRange As Range Dim C As Integer With Sheets("KEY") Set rngNext = .Range("B500").End(xlUp).Offset(1, 0) End With rngNext.Select Set myRange = Range("B2", rngNext) With ComboBox1 For Each rngNext In myRange If rngNext <> "" Then .AddItem rngNext Next rngNext End With Call RemoveDuplicates(1) End sub Private Sub RemoveDuplicates(X) 'Remove Duplicates Dim i As Long Dim j As Long With
  • 用于删除数组中重复项的 VBA (Microsoft Access) 函数(VBA (Microsoft Access) Function to delete duplicates in Array)
    问题 我需要一个函数来删除 VBA 中数组中的重复元素,我已经搜索过这个但是没有一个给定的函数对我有用,它们总是给出某种错误。 所以假设我有一个字符串数组: Dim strArray() As String strArray = Split("word1, word2, word3, word1, word2, word4", ",") 我需要一个函数,它将返回另一个“过滤数组”,它不包含重复项,因此它将包含“word1、word2、word3、word4”有人可以帮助我吗? 谢谢! 回答1 Function FilterWords(words() As String) As String() Dim word As Variant Dim newWords As String For Each word In words If InStr(newWords, word) = 0 Then newWords = newWords & word & "," Next word FilterWords = Split(Left(newWords, Len(newWords) - 1), ",") End Function 像这样使用 Sub main() Dim strArray() As String, strFilteredArray() As String strArray =
  • VBA:使用变量传递列数组时,删除重复项失败(VBA: Remove duplicates fails when columns array is passed using a variable)
    问题 当使用变量传递RemoveDuplicates的Columns参数时,它将失败并引发错误。 将列直接作为Array(1,2)传递时,相同的代码有效 错误5:无效的过程调用或参数 Sub test() Dim arrCols arrCols = Array(1, 2) '/This here works Sheet1.Range("$A$1:$B$10").RemoveDuplicates Columns:=Array(1, 2), Header _ :=xlYes '/ Same code fails when the columns array is passed via variable '/ Error 5: Invalid procedure call or argument Sheet1.Range("$A$1:$B$10").RemoveDuplicates Columns:=arrCols, Header _ :=xlYes End Sub 回答1 将()放在数组周围: Sub test() Dim arrCols As Variant arrCols = Array(1, 2) '/This here works Sheet1.Range("$A$1:$B$10").RemoveDuplicates Columns:=Array(1, 2), Header _
  • VBA Word 的重复删除无法有效工作(Duplicate removal for VBA Word not working effectively)
    问题 我有一个删除重复项的程序,一切正常。 它只是冻结了大型数据集,即 1 到 250 万个单词。 我的方法有什么问题? 有没有更好的? Sub DeleteDuplicateParagraphs() Dim p1 As Paragraph Dim p2 As Paragraph Dim DupCount As Long Dim StartTime As Double Dim SecondsElapsed As Double StartTime = Timer For Each p1 In ActiveDocument.Paragraphs If p1.range.Text <> vbCr Then For Each p2 In ActiveDocument.Paragraphs If p1.range.Text = p2.range.Text Then DupCount = DupCount + 1 If p1.range.Text = p2.range.Text And DupCount > 1 Then p2.range.Delete End If Next p2 End If DupCount = 0 Next p1 SecondsElapsed = Round(Timer - StartTime, 2) MsgBox "This code ran successfully
  • 删除excel 2003 vba列中的重复条目(Delete duplicate entries in a column in excel 2003 vba)
    问题 那么问题是,我有一个列,例如 Y 列中有很多条目,将近 40,000 个,并且每周都在增加。 问题是我必须检查 Y 列中的重复项并删除整行。 因此,Y 列应该只有唯一的条目。 假设我有 3,000 个条目,1 周后,我将有大约 3,500 个条目。 现在我必须检查这些新添加的 500 列值而不是 3,500 与旧的 + 新的即 3,500 个条目并删除重复的行。 不应删除或更改旧的 3,000。 我找到了宏,但它们对整个列都有效。 我想过滤新的 500 个值。 Cells(2, "Q").Formula = "=COUNTIF(P$1:P1,P2)=0" 'I have used these formula Range("Q2").Copy Destination:=Range("Q3:Q40109") 'it gives false for the duplicate values 我知道我们必须对重复条目使用countif 。 但我所做的是应用公式,然后搜索错误条目,然后将其删除。 我相信应用公式并发现错误,然后删除它的一点点时间。 Sub DeleteDups() Dim x As Long Dim LastRow As Long LastRow = Range("A65536").End(xlUp).Row For x = LastRow To 1 Step -1
  • 如何快速删除两个Excel工作表之间的重复项VBA(How do I delete duplicates between two excel sheets quickly vba)
    问题 我正在使用vba,我有两张纸,一张被命名为“ Do Not Call”,并且在A列中有大约80万行数据。我想使用此数据来检查第二张纸中名为“ Sheet1”的第一列。 如果找到匹配项,我希望它删除“ Sheet1”中的整个行。 我对在类似问题中发现的代码进行了定制:将Excel公式交叉引用2张纸,从一张纸中删除重复的纸并运行它,但是什么也没有发生。 我没有收到任何错误,但没有运行。 这是我目前正在尝试的代码,不知道为什么它不起作用 Option Explicit Sub CleanDupes() Dim wsA As Worksheet Dim wsB As Worksheet Dim keyColA As String Dim keyColB As String Dim rngA As Range Dim rngB As Range Dim intRowCounterA As Integer Dim intRowCounterB As Integer Dim strValueA As String keyColA = "A" keyColB = "I" intRowCounterA = 1 intRowCounterB = 1 Set wsA = Worksheets("Do Not Call") Set wsB = Worksheets("Sheet1") Dim
  • 如何使用 VBA 在 Excel 中搜索单词,然后删除整行? [复制](How do I search for a word in Excel Using VBA and then Delete the entire row? [duplicate])
    问题 这个问题在这里已经有了答案: 如果单元格包含字符串 X 则删除整行(7 个回答) 8 年前关闭。 有人请帮忙。 我正在尝试编写一个 VBA 代码,在我的 excel 工作表列“D”中搜索特定单词“DR”,然后删除整行。 工作表中出现了很多特定单词。 我想要做的就是搜索这些出现,然后删除包含这些词的整行。 我的问题是我不确定要使用什么循环结构。 下面是我正在使用的代码。 列(“D:D”)。选择 Cells.Find(What:="DR", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False). 激活 做 Cells.Find(What:="DR", After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _ xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _ , SearchFormat:=False). 激活 ActiveCell.EntireRow.Delete Loop While (Cells
  • 尽管 displayalerts=false,但通过 VBA 删除重复项仍然会弹出(Removing Duplicates through VBA still throws pop up despite displayalerts=false)
    问题 我的电子表格中的 C 列包含将由客户选择并经常更新的值。 我希望 D 列动态应用从该列表中提取的数据验证。 但是,它需要包含按字母顺序排列的唯一值。 我目前正在做的是使用以下公式按字母顺序对隐藏列 (BK) 中的这些值进行排序。 (注意:我在其上找到的站点表明它应该只显示唯一值,但它没有)。 {=INDEX(List,MATCH(0,IF(MAX(NOT(COUNTIF($BK$15:BK15,List))*(COUNTIF(List,">"&List)+1))=(COUNTIF(List,">"&List)+1),0,1),0))} 要动态更新列 D,我使用以下代码: Dim NewRng As Range Dim RefList As Range, c As Range, rngHeaders As Range, RefList2 As Range, msg On Error GoTo ErrHandling Set NewRng = Application.Intersect(Me.Range("D16:D601"), Target) If Not NewRng Is Nothing Then Set rngHeaders = Range("A15:ZZ16").Find("Status List", After:=Range("E15")) Set RefList =
  • VBA - 删除以分号分隔的一个字符串中的重复项(VBA - Deleting duplicated in one string which are separated by semicolon)
    问题 我收到了一个字符串,比如 800 封地址电子邮件。 它们用分号隔开。 我应该如何删除该字符串中的重复项? 回答1 请更新您的问题以显示您已经尝试过的内容。 您当前的代码很可能只需要进行一些调整。 下面是一个更通用的方法来完成你所追求的,但就像我说的,可能有一种更简单的方法来修复你当前的代码,你不会通过复制和粘贴代码来真正学习。 Function RemoveDuplicates(rng as Range) As String Dim dict As Object Dim var As Variant, v As Variant Set dict = CreateObject("Scripting.Dictionary") var = Split(rng.Value,";") For each v in var If Not dict.Exists(v) Then dict.Add v, v End If Next v RemoveDuplicates = Join(dict.Keys, ";") End Function
  • 删除两个工作表“区分大小写”之间的重复项(Delete duplicates between two sheets "Case Sensitive")
    问题 我想比较excel中的两张工作表,如果vba发现重复项,它将删除它们。 我已经搜索了一段时间,终于在这里找到了我想要的东西。 “如何快速删除两个 Excel 工作表之间的重复项 vba” 但就我而言,这对我不起作用。 因为这个脚本认为 abc 和 AbC 是重复的。 那么无论如何要修改脚本,以便所有字母都区分大小写。 回答1 更改字典的 CompareMode。 有关详细信息,请查看此处:http://msdn.microsoft.com/en-us/library/a14xez73(v=vs.84).aspx Dim dict As Object Set dict = CreateObject("Scripting.Dictionary") ' add this line: dict.CompareMode = BinaryCompare
  • 删除重复行 Excel VBA(Remove duplicate rows Excel VBA)
    问题 我正在用 VBA 编写一个脚本来删除 Excel 电子表格中的重复行。 但是,我希望它仅考虑两列中的信息来删除重复的行。 换句话说,我有一个范围为 B:F 的表格。 我希望脚本删除重复的行,对于每一行,只考虑列 D 和 E 上的值。最后,只有在列 D 和 E 上同时具有完全相同值的行 - 无论其他列 - 将被删除. 我怎么能去做这件事? 谢谢 回答1 这是执行此操作的示例。 确保使用要用完的工作表运行它: Sub DeleteDupes() Dim x For x = Cells(Rows.CountLarge, "D").End(xlUp).Row To 1 Step -1 If Cells(x, "D") = Cells(x, "E") Then 'This line deletes the row: Cells(x, "D").EntireRow.Delete xlShiftUp 'This line highlights the row to show what would be deleted; 'Cells(x, "D").EntireRow.Interior.Color = RGB(230, 180, 180) End If Next x End Sub 突出显示的结果: 删除结果: