3

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

应用宏之前数据的外观

示例数据

数据最终应该如何看待

这些数据最终应该如何看待

4

1 回答 1

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 更新的样本数据的输出：

在此处输入图像描述

于 2013-01-29T16:27:37.927 回答