使用 Excel 2007 删除重复行但将数据保留在三列中答案

【问题标题】：Remove duplicate rows but retain data in three columns using Excel 2007使用 Excel 2007 删除重复行但将数据保留在三列中
【发布时间】：2016-05-20 08:35:57
【问题描述】：

我会将 Excel 2007 文件导入 Access 2007，但在此之前，我必须对 Excel 文件进行处理，如下所示：

1.) 删除与 A 列中数值数据相关的重复行。

2.) 我需要将数据保留在三列（I、P 和 Q 列）中，并在 I、P 和 Q 列的保留行单元格中组合该字母数字数据，用分号分隔。

3.) 如果重复行中的 I、P 和 Q 列中的任何数据已经存在，则不要保留那个重复数据

从此...

致这个...

我会永远感激这里的帮助。 Kinda 被拉进了这个“小项目”，因为我知道 Excel 和 Access 是什么。好的。 :)

【问题讨论】：

欢迎来到 Stack Overflow。正如许多新成员错误地认为的那样，堆栈溢出不是我网站的代码。如果您有现有的代码堆栈溢出将有助于解决该代码中的特定问题。此外，最好将您的数据直接显示在原始帖子中，以便我们可以复制和粘贴，而不是重新输入您的样本进行测试。
正如斯科特所说，这不是“我的代码”网站。但首先，我会扫描所有行并检查Worksheets("data").cells(i+1,1)==Worksheets("data").cells(i,1)。如果为真，我会将连接的数据写入新工作表：Worksheets("Results").cells(k,9)=Worksheets("data").cells(i+1,9) & Worksheets("data").cells(i,9)。另请参阅this。

标签： vba excel duplicates

【解决方案1】：

希望值得永远感激...

打开包含数据的工作表，按 ALT+F11 启动 IDE，然后单击“插入”->“模块”。这将在您的 VBA“项目”中添加一个“模块”

在“项目管理器窗口”中（单击查看->“项目管理器窗口”可能会显示它）双击“Module1”节点以打开模块代码窗格并将此代码放入其中

Option Explicit

Sub RemoveDupesAndRetainData()

    Dim cell As Range
    Dim nDupes As Long

    With ActiveWorkbook.Worksheets("Data") '<~~ change sheet name as per your needs
        With .Range("A1:Q" & .Cells(.Rows.Count, 1).End(xlUp).Row) '<~~ data are in columns A to P and start from row 1 (headers)

            .Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlYes '<~~ sort rows by "Order"
            For Each cell In .Offset(1).Resize(, 1).SpecialCells(xlCellTypeConstants) '<~~ loop through each cell in columns A containing values
                nDupes = WorksheetFunction.CountIf(.Columns(1), cell.Value) - 1 '<~~ count duplicates
                If nDupes > 0 Then '<~~ if there are any ...
                    .AutoFilter Field:=1, Criteria1:=cell.Value '<~~ ...filter data by "order" as current cell content -> only rows with same current cell content will be displayed...

                    With .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible) ''<~~ ...consider only visible cells of data range, skipping headers row...
                        Intersect(cell.EntireRow, .Columns("I")).Value = Join(Application.Transpose(Intersect(.Cells, .Columns("I").EntireColumn)), ";") ' ...concatenate "Resource" field...
                        Intersect(cell.EntireRow, .Columns("P")).Value = Join(Application.Transpose(Intersect(.Cells, .Columns("P").EntireColumn)), ";") ' ...concatenate "Special" field...
                        Intersect(cell.EntireRow, .Columns("Q")).Value = Join(Application.Transpose(Intersect(.Cells, .Columns("Q").EntireColumn)), ";") ' ...concatenate "Notes" field...
                        cell.Offset(1).Resize(nDupes).EntireRow.Delete '<~~ delete duplicate rows
                    End With

                    .AutoFilter '<~~ remove filters
                End If
            Next cell

        End With
    End With

End Sub

返回 Excel UI，按 Alt+F8 弹出宏对话框

在组合框中选择“RemoveDupesAndRetainData”，然后按“执行”按钮

看看会发生什么...如果出现错误，您可以按错误消息框中的“调试”按钮，将您扔到 VBA 编辑器中导致错误的行

另一种运行宏的方法如下：

在 VBA IDE（Excel UI 中的 ALT+F11）模块代码窗格中（在项目管理器窗口中双击所需的模块节点）将鼠标光标放在 Sub RemoveDupesAndRetainData 和 End Sub 语句之间的任意点并按F8 让您的宏以黄色阴影的第一行开始

现在按 F8 键单步执行每个将被执行的代码行，这些代码行也将带有黄色阴影

在每一步，您都可以通过将鼠标悬停在代码中出现的任何变量上或在即时窗口中输入? variable_name（您可以通过单击“Ctrl +G" 或选择查看->立即窗口)

将鼠标光标放在任何有意义的代码“word”中并按“F1”将启动相关帮助主题以了解该特定对象。每个主题都有超链接可以深入挖掘并获得更多相应信息

当然，网络是另一个非常宝贵的知识来源，在这里可以找到您当前需要的几乎所有内容，其中有几十个专门针对 Excel 和 VBA 的博客

我认为上面的内容会让你开始，更重要的是，继续

这是一段很长的路，但这里所有帮助编码人员的人都是这样开始的，但从未走到尽头

【讨论】：

【解决方案2】：

我这边的其他变体：

Sub test()
    Dim cl As Range, Data As Range, key$, item$, k
    Dim Dic As Object: Set Dic = CreateObject("Scripting.Dictionary")
    Dic.CompareMode = vbTextCompare

    With Sheets("SheetName") 'specify Sheet Name
        Set Data = .Range("A2:Q" & .[A:A].Find("*", , , , xlByRows, xlPrevious).Row)
        Data.RemoveDuplicates Array(1, 9, 16, 17), xlYes
    End With

    For Each cl In Data.Columns(1).Cells
        key = cl.Value2
        item = cl.Offset(, 8).Value2 & "|" & cl.Offset(, 15).Value2 & "|" & cl.Offset(, 16).Value2
        If Not Dic.exists(key) Then
            Dic.Add key, item
        Else
            Dic(key) = Split(Dic(key), "|")(0) & ";" & Chr(10) & Split(item, "|")(0) & "|" & _
                       Split(Dic(key), "|")(1) & ";" & Chr(10) & Split(item, "|")(1) & "|" & _
                       Split(Dic(key), "|")(2) & ";" & Chr(10) & Split(item, "|")(2) & "|"

        End If
    Next cl

    Data.RemoveDuplicates (1), xlYes
    For Each k In Dic
        If Dic(k) Like "*;*" Then
            Set cl = Data.Columns(1).Find(k)
            With cl
                .Offset(, 8).Value2 = Split(Dic(k), "|")(0)
                .Offset(, 15).Value2 = Split(Dic(k), "|")(1)
                .Offset(, 16).Value2 = Split(Dic(k), "|")(2)
            End With
        End If
    Next k
End Sub

之前：

之后：

【讨论】：