Question

我将Excel 2007文件导入Access 2007，但在此之前，我必须按摩Excel文件，如下所示：

1。）删除与A列中的数字数据相关联的重复行。

2.）我需要将数据保留在三列（第I列，第P列和第Q列）中，并将字母数字数据（以分号分隔）组合在列I，P和Q的保留行单元格中。< / p>

3。）如果来自重复行的第I，P和Q列中的任何数据已经存在，那么不要保留重复数据

从此...

To This ...

我会永远感激这里的帮助。有点被吸引到这个“迷你项目”，因为我知道Excel和Access是什么。尼斯。：）

Answer 1

希望得到永恒的感激......

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

＆＃34;项目经理窗口中的

＆＃34> （单击View-＆gt;＆＃34; Project Manager Window＆＃34;可能显示它）双击＆＃34; Module1＆＃34;节点打开模块代码窗格并将此代码放在其中

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弹出宏对话框

选择＆＃34; RemoveDupesAndRetainData＆＃34;在组合框中然后按下＆＃34;执行＆＃34;按钮

观察会发生什么......如果出现错误，您可以按＆＃34;调试＆＃34;错误消息框中的按钮将您引入VBA编辑器中导致错误的行

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

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

现在按F8逐步执行将要执行的每个代码行，并且黄色阴影也是

在每个步骤中，您可以通过将鼠标悬停在代码中的任何位置或通过在立即窗口中键入End Sub来查询每个变量值（您可以通过单击来显示）＆＃34; Ctrl + G＆＃34;或选择View-＆gt; Immediate Window）

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

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

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

它还有很长的路要走，但是这里帮助编码研究员的每个人都是这样开始的，而且从来没有达到过它的目的

Answer 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

之前的：

后的：

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

2 个答案: