1

我有一个如下电子表格： 合并重复项

我可以使用此处的脚本合并重复项。

但是，我不知道将列 A 添加到合并列 (K) 中。任何帮助表示赞赏！

谢谢

4

2 回答 2

1

假设第 1 行是标题行，因此实际数据从第 2 行开始，并且您希望输出从单元格 J2 开始，此代码应该适合您：

Sub tgr()

    Dim cllSKU As Collection
    Dim SKUCell As Range
    Dim rngFound As Range
    Dim arrData(1 To 65000, 1 To 2) As Variant
    Dim strFirst As String
    Dim strJoin As String
    Dim DataIndex As Long

    Set cllSKU = New Collection

    With Range("G3", Cells(Rows.Count, "G").End(xlUp))
        On Error Resume Next
        For Each SKUCell In .Cells
            cllSKU.Add SKUCell.Text, SKUCell.Text
            If cllSKU.Count > DataIndex Then
                DataIndex = cllSKU.Count
                arrData(DataIndex, 1) = SKUCell.Text
                arrData(DataIndex, 2) = Cells(SKUCell.Row, "A").Text & " - ("
                Set rngFound = .Find(SKUCell.Text, .Cells(.Cells.Count), xlValues, xlWhole)
                If Not rngFound Is Nothing Then
                    strFirst = rngFound.Address
                    Do
                        arrData(DataIndex, 2) = arrData(DataIndex, 2) & Cells(rngFound.Row, "H").Text & ","
                        Set rngFound = .Find(SKUCell.Text, rngFound, xlValues, xlWhole)
                    Loop While rngFound.Address <> strFirst
                End If
                arrData(DataIndex, 2) = Left(arrData(DataIndex, 2), Len(arrData(DataIndex, 2)) - 1) & ")"
            End If
        Next SKUCell
        On Error GoTo 0
    End With

    If DataIndex > 0 Then
        Range("J2:K" & Rows.Count).ClearContents
        Range("J2:K2").Resize(DataIndex).Value = arrData
    End If

    Set cllSKU = Nothing
    Set SKUCell = Nothing
    Set rngFound = Nothing
    Erase arrData

End Sub
于 2013-08-08T19:30:26.180 回答
0

可以
在没有.VBA 的情况下实现，但无疑比复制代码对您来说工作量更大！：假设您的标题位于第 3 行。

  1. 复制您的工作表并处理副本。
  2. 在 I3 中输入：
    =IF(COLUMN()<COUNTIF($G:$G,$G3)+8,IF($G3=$G4,INDIRECT("$h"&ROW()+COLUMN()-8),""),"")
  3. 将公式复制到（至少到 ColumnL，但根据需要，比如到 ColumnZ）并向下复制以适应。
  4. 在第 3 行的两个相邻列（我假设 M 和 N）中放入：
    [M] =H3&","&I3&","&J3&","&K3&","&L3 (extended as required)
    [N] =A3&" - "&"("&M3（替换M为步骤 3 中列的列引用）并将两者复制下来以适应。
  5. 复制 ColumnN 并将特殊值粘贴到顶部。
  6. 在 ColumnN 中替换为空,,。
  7. 在第 3 行的两个相邻列（我假设为 O 和 P）中输入：
    [O] =IF(RIGHT(N3,1)=",",LEFT(N3,LEN(N3)-1)&")",N3&")")
    [P] =G2=G3
    并将这些复制下来以适应。
  8. 复制整个工作表并将特殊值粘贴到顶部。
  9. 筛选 ColumnP 以选择 TRUE 并将 Row4 删除到最后。
  10. 取消过滤。
  11. 删除除 ColumnO 和 ColumnG 之外的所有列。
  12. 放入MergedB2。

请注意，这不会为您的问题中显示的 Tops 提供 M 和 XL 之间的空间。

于 2013-08-08T20:58:52.447 回答