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のコメントと更新ごとのAS

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 に答える