使用修改后的数据从列表转换为平面CSV

时间:2014-12-30 17:41:44

标签: excel vba excel-vba excel-formula

我有爱尔兰/苏格兰氏族名称的列表,我需要将其放入我的搜索模块使用的格式中。这是问题所在:

O'Quinn     Antrim
Quillan     Antrim
Quin        Antrim
Quinn       Antrim
Alinden     Armagh
Baron       Armagh
Barron      Armagh
Branagan    Armagh
Calan       Armagh

我有一些名称列表(15个文件中包含2-10k行的100k +),我希望将其转换为可行的样式。我希望看到他们这样:

Antrim:O'Quinn, Quillan, Quin, Quinn, 
Armagh:Alinden, Baron, Barron, Branagan, Calan

任何人都有任何关于如何在没有大量人工干预的情况下实现这一目标的想法?

2 个答案:

答案 0 :(得分:3)

在三个部分中,假设O'Quinn在A2中:

  

创建字符串

在C2中:

=IF(B1<>B2,B2&": "&A2,C1&", "&A2)  
  

确定相关的

在D2:

=B2<>B3  
  

整理

复制C2:D2以适应。
选择“纸张”,“复制”,“粘贴特殊值” 过滤ColumnD以选择FALSE并删除所有可见和列D和A. 重复其他14个文件。

答案 1 :(得分:2)

我在另一个答案中使用了这样的东西:(编辑:修正了一些小错误和更新的语法)经过测试的工作!

代码前:
enter image description here

Sub RemoveDups()

Dim CurRow As Long, LastRow As Long, LastCol As Long, DestLast As Long, DestRng As Range, ws As Worksheet

Set ws = ActiveSheet
LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row

For CurRow = LastRow To 3 Step -1
     Set DestRng = ws.Range("B1:B" & CurRow - 1).Find(ws.Range("B" & CurRow).Value, LookIn:=xlValues, LookAt:=xlWhole, SearchDirection:=xlNext)
     If DestRng Is Nothing Then
         'Do Nothing
     Else
        DestLast = ws.Cells(DestRng.Row, Columns.Count).End(xlToLeft).Column + 1
        ws.Cells(DestRng.Row, DestLast).Value = ws.Cells(CurRow, 1).Value
        ws.Cells(CurRow, 1).EntireRow.Delete xlShiftUp
     End If
     Next CurRow
ws.Columns("B:B").Cut
ws.Columns("A:A").Insert Shift:=xlToRight
Application.CutCopyMode = False

End Sub

代码后:
 enter image description here