Excel 2007宏移动重复项

Question

首先，我对Excel宏一无所知，所以我真的不知道我在做什么，但是任何帮助都将不胜感激。

我有一个包含A-G行列（没有标题）的电子表格。

列A包含一个ID，我想要做的是将任何重复的ID从列结构剪切到行结构中。每个ID最多可能需要移动9行。

例如：当前格式：

Row 1 - ID123 / Bob / James / 12345 / 1 / A1 / 120
Row 2 - ID124 / John / Smith / 2351 / 5 / C2 / 121
Row 3 - ID124 / John / Smith / 25562 / 1 / A2 / 162
Row 4 - ID162 / Gary / Barlow / 251767 / 9 / B1 / 167

目标格式：

Row 1 - ID123 / Bob / James / 12345 / 1 / A1 / 120
Row 2 - ID124 / John / Smith / 2351 / 5 / C2 / 121 / 25562 / 1 / A2 / 162
Row 3 - ID162 / Gary / Barlow / 251767 / 9 / B1 / 167

我的问题是 - a）这可行吗？ b）我该如何实现它（我很乐意自己解决，但由于我是VBA初学者，指点方向会很方便！）

宏应用之前数据的外观

如何结束数据的外观

- franglais

---

a) 当然。 b) 暂时不写整个解决方案，我会开始循环遍历行，保存找到的ID，当你发现重复项（已经找到的内容）时，返回到该行，追加新值并删除后面的行。 - lc.

穷人的解决方案可能只是做一个数据透视表，这样你就可以分组并得到类似的结果。但我不确定这是否对你适用。 - lc.

Answer 1

你可以试试这个方法。它使用了一个“字典”对象。该解决方案假设每行都以“Row 1 - ID123 / Bob / James”模式开头。

Option Explicit

Sub mergeDuplicates()
Dim d As Object
Dim rng As Range
Dim vArr As Variant
Dim i As Integer, j As Integer

Set rng = Sheets(3).Range("A2:H5")
Set d = CreateObject("Scripting.Dictionary")
vArr = rng.Value

For i = LBound(vArr) To UBound(vArr)
    If Not d.Exists(vArr(i, 2)) Then '-- check for unique ID
        d.Add vArr(i, 2), Trim(Replace(vArr(i, 1), "-", ""))
        For j = 2 To UBound(vArr, 2)
            d.Item(vArr(i, 2)) = d.Item(vArr(i, 2)) + "/" & Trim(Replace(vArr(i, j), "/", ""))
        Next j
    Else
        For j = 5 To UBound(vArr, 2)
            d.Item(vArr(i, 2)) = d.Item(vArr(i, 2)) + "/" & Trim(Replace(vArr(i, j), "/", ""))
        Next j
    End If
Next i

'-- output to sheet
rng.Offset(5).Resize(UBound(d.items) + 1, 1) = Application.Transpose(d.items)

'-- split the text to columns
rng.Offset(5).Resize(UBound(d.items) + 1, 1).TextToColumns Destination:= _
        rng.Offset(5), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
        Tab:=True, Semicolon:=False, Comma:=False, Space:=False, _
        Other:=True, OtherChar:="/"

Set d = Nothing
End Sub

输出：

---

根据OP的评论和更新：

更改“for循环”的内容以适应其真实数据。

For i = LBound(vArr) To UBound(vArr)
    If Not d.Exists(vArr(i, 1)) Then '-- check for unique ID
        d.Add vArr(i, 1), Trim(vArr(i, 1)) '-- add RowID as first element in item
        For j = 2 To UBound(vArr, 2)  '-- then append each element(column) to the first element
            d.Item(vArr(i, 1)) = d.Item(vArr(i, 1)) + "/" & Trim(Replace(vArr(i, j), "/", ""))
        Next j
    Else
        For j = 4 To UBound(vArr, 2)  '-- when duplicates found, append from 4th column
            d.Item(vArr(i, 1)) = d.Item(vArr(i, 1)) + "/" & Trim(Replace(vArr(i, j), "/", ""))
        Next j
    End If
Next i

根据原帖更新后的示例数据输出：

- bonCodigo

---

@sam.clements 如果你感兴趣的话，请试一试，然后评论。在这个解决方案中，表格和范围是静态的，因为它只是一个演示。你可以根据自己的需求进行设置。 - bonCodigo

嗨，BonCodigo，我在让这个工作时遇到了一些问题，但可能是由于我的设置！数据中没有“Row 1-”“Row 2-”等或“/”，我只是在问题中加入它以尝试显示我的数据格式！ - franglais

@sam.clements 你可以追加几行精确的样本数据吗？（请不要更改之前的样本数据）。如果你能展示几行清晰的屏幕截图就更好了。 - bonCodigo

嗨，它对几周的数据完全正常运行，但在最近一周的数据上出现了不匹配错误。没有更改任何数据类型，所以我有点困惑该怎么解决这个问题！我更改了范围并确定它在一个空白行上出错（但是有多个空白行），已尝试删除行或更改数据类型，但仍然出现错误！有什么想法吗？ - franglais

你能否发送一份带有样本数据的表格（不要全部数据，否则下载和处理会很困难）？请确保发送包含错误的文件。我不太喜欢从 OP 中查看文件，但在你的情况下，让我来看看你的表格吧。我的电子邮件地址在主页上。 - bonCodigo