从具有重复数据的行复制特定列

时间:2016-01-27 19:39:01

标签: excel vba excel-vba

尝试在Excel中完成所有操作,因为最终用户不会拥有MS Access(这会使这个数十倍的容易......)。

我有一张包含数据行的表格,如:

ticket  date      name           comments
52      1/1/2016  Edgar          did thing A
52      1/1/2016  Edgar          did thing B
52      1/2/2016  Edgar          did thing C
60      1/5/2016  Steph          looked at X
60      1/5/2016  Steph          looked at Y

我需要编写一个公式(或VBA宏),它将遍历所有行并根据票证#连接注释。即在上面的例子中,最终结果将是:

Ticket   date      name         comments
52       1/1/2016  Edgar        did thing A, did thing B, did thing C
60       1/5/2016  Steph        looked at X, looked at Y

我尝试过一些类似的问题,但没有发现任何我能操作以满足我需要的东西。

很想听听专家的想法。该表将每月进行核对,并且长度不同。

2 个答案:

答案 0 :(得分:1)

这应该可以解决问题:

Sub Main()

    Dim wb As Workbook
    Dim ws As Worksheet
    Dim i As Long, j As Long

    Set wb = ThisWorkbook
    Set ws = wb.Sheets("Sheet1") ' Change the name of your Sheet

    Lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row


With ws

    j = 2 ' Start the loop at row 2

    Do While Not IsEmpty(.Cells(j, 1))
            For i = Lastrow To 2 Step -1

                        If j <> i And .Cells(j, 1) = .Cells(i, 1) Then
                            .Cells(j, 4) = .Cells(j, 4) & "," & .Cells(i, 4)
                            .Rows(i).EntireRow.Delete
                        End If

            Next i
    j = j + 1
    Loop

End With

End Sub

答案 1 :(得分:1)

好问题!这一点特别有趣,因为您需要在通常移动的相反方向调整源数据 - 您将数据转换为“不可转动”状态。

I wrote about a tutorial for a very similar situation here - 不要把露营者放在小木屋里,而是需要在门票中加注。 (您还需要将注释组合到单个逗号分隔的单元格中。)

假设您要遵循该指南并汇总两个Scripting.Dictionary个对象dicTicketsdicComments,其中dicTickets包含代表“Ticket”值的Keys和Items并且dicComments包含“评论”作为键,“票证”作为项目。

有了这些结构,你可以像我在评论很多但未经过测试的代码中那样循环遍历它们:

'We'll need these, so you'll probably want to declare them up at the top
Dim dicTickets As Scripting.Dictionary, dicComments As Scripting.Dictionary
Set dicTickets = New Scripting.Dictionary
Set dicComments = New Scripting.Dictionary
Dim colCombinedComments As Collection
Dim varTicket As Variant, varComment As Variant
Dim strComments As String
Dim lngIdx As Long

'...
'Fill up the Scripting.Dictionary objects as described in the guide
'...

'"Outer" loop iterates through all the tickets
For Each varTicket in dicTickets.Keys

    '"Inner" loop iterates through all the comments
    For Each varComment in dicComments.Keys

        'Initialize a collection to store all the comments
        Set colCombinedComments = New Collection

        'If this comment matches the current ticket, add it to a string
        If dicComment(varComment) = dicTickets(varTicket) Then
            colCombinedComments.Add dicComment(varComment)
        End If

        'colCombinedComments now contains the comments, yay!

        'Initialize a string to join all the comments together
        'with commas
        strComments = ""

        'Loop through the colCombinedComments, appending each time
        For lngIdx = 1 To colCombinedComments.Count

            'The first time, just make strComments the first comment
            If strComments = "" Then
                strComments = colCombinedComments(lngIdx)

            'Each time after the first time, append with a comma and space
            Else
                strComments = strComments & ", " & colCombinedComments
            End If
        Next lngIdx

        '...
        'Now you can do what you need to with strComments
        '...

    Next varComment

Next varTicket