Excel 2007宏移动重复项

Question

首先我对Excel Macros一无所知，所以我真的不知道我在做什么，但任何帮助都会非常感激。

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

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

e.g。 目前的格式：

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的初学者，指向正确的方向会很方便！）

在应用宏之前数据的外观如何

数据应该如何结束

Answer 1

你可以尝试一下。它使用dictionary对象。此解决方案假设每行以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 loop内容以适应。

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

根据OP更新的样本数据输出：