Excel:1.auto搜索重复行> 2.组合柱> 3.删除重复项

时间:2015-02-21 12:30:59

标签: excel excel-vba vba

我在几个小时内尝试了很多组合,但我无法找到解决方案。我有一个包含20k数据的excel文件,这就是我想要做的事情:

 ItemOEM     BrandTxt
 51604A     ThinkJet
 51604A     QuietJet
 51605R     ThinkJet
 51605R     QuietJet

为:

 ItemOEM     BrandTxt
 51604A      ThinkJet,QuietJet
 51605R      ThinkJet,QuietJet

我的整个excel文件包含数千行。可能吗?如果是的话,怎么样?提前谢谢。

1 个答案:

答案 0 :(得分:0)

Excel-VBA标记已添加到您的问题中,因为VBA将需要将此过程自动化到任何成功级别。

Sub concat_dedupe()
    Dim rw As Long, fnd As Range
    Application.EnableEvents = False
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    With ActiveSheet.Cells(1, 1).CurrentRegion
        With .Columns(1)
            For rw = 2 To .Rows.Count
                If CBool(Application.CountIf(.Cells.Offset(rw, 0), .Cells(rw, 1).Value)) Then
                    If Not CBool(Application.CountIf(.Cells.Resize(rw - 1), .Cells(rw, 1).Value)) Then
                        Set fnd = .Find(What:=.Cells(rw, 1).Value, After:=.Cells(rw, 1), LookIn:=xlFormulas, _
                                        LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext, _
                                        MatchCase:=False, SearchFormat:=False)
                        Do While fnd.Address <> .Cells(rw, 1).Address
                            .Cells(rw, 1).Offset(0, 1) = .Cells(rw, 1).Offset(0, 1).Value & "," & fnd.Offset(0, 1).Value
                            Set fnd = .FindNext(fnd)
                        Loop
                    End If
                End If
            Next rw
        End With
        .RemoveDuplicates Columns:=1, Header:=xlYes
    End With
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

您的问题让我感兴趣的是,在字符串连接之后随后删除重复项实际上会减少必要的字符串连接数,因为只有 ItemOEM 的第一个实例才会保留它。这是否会提高效率将是有多少串连接的因素;例如检查该 ItemOEM 上的先前操作,从长远来看保存处理周期。这将取决于有多少重复,但我认为这是更好的方法。