删除重复的行，但使用Excel 2007将数据保留在三列中
我将导入一个Excel 2007文件到Access 2007中，但在此之前，我必须按照下面的Excel文件：
1.）删除列A中与数字数据关联的重复行
2.）我需要将数据保留在三列（列I，P和Q）中，并将这些字母数字数据（分号分隔）组合到列I，P和Q的保留行单元格中。
3.）如果来自重复行的列I，P和Q中的任何数据已经存在，则不要保留重复的数据
由此…
对…
我会永远感激这里的帮助。 有点被拉进了这个“小型项目”，因为我知道Excel和Access是什么。 尼斯。 🙂
希望得到永恒的感激…
用数据打开你的工作表，按下ALT + F11启动IDE并点击Insert-> Module。 这将在您的VBA“项目”中添加一个“模块”
在“项目pipe理器窗口”（点击查看 – >“项目pipe理器窗口”可能显示它）双击“模块1”节点打开模块代码窗格并将此代码放在其中
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 + F8popupmacros对话框
selectcombobox中的“RemoveDupesAndRetainData”，然后按下“执行”button
看看会发生什么…如果出现错误，您可以按错误消息框中的“debugging”button将您引导到VBA编辑器的右侧，导致错误
运行macros的另一种方式如下：
在VBA IDE（Excel UI中的ALT + F11）模块代码窗格中（双击项目pipe理器窗口中需要的模块节点），将鼠标光标放在Sub RemoveDupesAndRetainData和End Sub语句之间的任意点，然后按F8以使您的macros从第一行开始黄色阴影
现在按F8来遍历每一条将被执行的代码行，并且也将着色为黄色
在每一步你可以通过鼠标hover在代码中的任何出现，或通过键入? variable_name查询每个variables值? variable_name 立即窗口中的? variable_name （可以通过点击“Ctrl + G”或selectView-> Immediate Window来显示）
将鼠标光标置于任何有意义的代码“单词”中并按“F1”将启动相关帮助主题以了解该特定对象。 每个主题将有超链接挖掘并获取更多相应的信息
当然networking是另一个宝贵的知识来源，几乎所有你需要的东西，几十个特定于Excel和VBA的博客
我想上面的内容会让你开始，更重要的是继续
这是一个很长的路，但是这里所有帮助编码人员的人都是这样开始的，而且从来没有达到过
来自我身边的其他变体：
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
之前 ：
之后 ：
