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

试图在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 

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

 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 

我已经试过了一些类似的问题,但还没有find任何能够适应我的需求的操作。

很想听听你的专家的想法。 该表将每月对帐,并将有不同的长度。

这应该做的伎俩:

 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 

好问题! 这是特别有趣的,因为你需要调整你的源数据在相反的方向,通常的举动 – 你正在获取数据进入“不可摆动”的状态。

我在这里写了一个关于一个非常类似的情况的教程,而不是把露营者放在小屋里,但是你需要在门票中加注释。 (您还需要将注释合并到一个由逗号分隔的单元格中。)

假设您要遵循该指南并组装两个Scripting.Dictionary对象, dicTicketsdicComments ,其中的dicTickets包含Keys和Items,它们都表示“Ticket”值,而dicComments包含“Comment”和Keys作为Items。

有了这些结构,你就可以像下面这样严格评论但未经testing的代码一样遍历它们:

 '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