[[20231204193651]]　『複数列の値が重複したデータを、削除ではなく空白』（よっち）　ページの最後に飛ぶ

『複数列の値が重複したデータを、削除ではなく空白にしたい』（よっち）

いつもお世話になっております。
VBAを使用し業務の簡略化をはかっているのですが、
御指南お願いしたい部分が出てきたので投稿させていただきました。

タイトル通り、複数列の値が重複した場合、一行目だけ残して空白にするマクロを組みたいと思っています。

例えば

りんご　みかん　バナナ　梨　
りんご　みかん　バナナ　桃
りんご　レタス　キウイ　苺

↓
りんご　みかん　バナナ　梨　
　　　　　　　　　　　　桃
りんご　レタス　キウイ　苺

のように、上のりんご、みかん、バナナと複数列に渡って重複した部分だけ空白にしたのです。

検索したところ、自分のやりたいことに近いのはこの命令かなと思ったのですが、

'重複行を削除
Worksheets("Sheet1").Range("A:C").RemoveDuplicates Columns:=Array(1, 3), Header:=xlYes

行を削除ではなく空白にしたい場合、どのような命令があるでしょうか
勉強不足で申し訳ないのですが、御指南いただければ幸いです。

＜使用 Excel：Microsoft365、使用 OS：Windows10 ＞

 数式案です。
 見出し行があったり、２行目からはじまっていることが前提ですが、

 F2 =IF(SUM(N(A1:D1=A2:D2))>1,IF(A1:D1=A2:D2,"",A2:D2),A2:D2) 下コピー

    |[A]   |[B]   |[C]   |[D]|[E]|[F]   |[G]   |[H]   |[I]
 [1]|      |      |      |   |   |      |      |      |   
 [2]|りんご|みかん|バナナ|梨 |   |りんご|みかん|バナナ|梨 
 [3]|りんご|みかん|バナナ|桃 |   |      |      |      |桃 
 [4]|りんご|レタス|キウイ|苺 |   |りんご|レタス|キウイ|苺 
（フォーキー） 2023/12/04(月) 20:27:38

 VBA案です。

 Sub test()
    Dim v, key$, tmp$, r&, c&
    With Sheets.Add
        Call SetData
        v = .Range("A1").CurrentRegion
        key = GetKey(v, 1)
        For r = 2 To UBound(v)
            tmp = GetKey(v, r)
            If tmp = key Then
                For c = 1 To UBound(v, 2) - 1
                    v(r, c) = Empty
                Next
            Else
                key = tmp
            End If
        Next
        .Range("F1").Resize(UBound(v), UBound(v, 2)) = v
    End With
 End Sub
 Sub SetData()
    [A1:A3].Formula2 = "=SEQUENCE(1,3)"
    [A4:A6].Formula2 = "=SEQUENCE(1,3,4)"
    [A7].Formula2 = "=SEQUENCE(1,3,7)"
    [A8:A10].Formula2 = "=SEQUENCE(1,3,10)"
    [D1].Formula2 = "=CHAR(SEQUENCE(10)+64)"
    [A1:D10].Value = [A1:D10].Value
 End Sub
 Function GetKey$(v, rowNo&)
    If Not IsArray(v) Then Exit Function
    Dim c&, key
    ReDim key(1 To UBound(v, 2) - 1)
    For c = 1 To UBound(v, 2) - 1
        key(c) = v(rowNo, c)
    Next
    GetKey = VBA.Join(key, "♪")
 End Function
（まる2021） 2023/12/04(月) 20:47:36

 Sub test()
    Dim dic As Object
    Dim r As Range, s As String

    Set dic = CreateObject("scripting.dictionary")

    For Each r In Cells(1).CurrentRegion.Rows
        s = WorksheetFunction.TextJoin(vbTab, False, WorksheetFunction.Sort(r, 1, 1, True))
        If dic.exists(s) Then r.ClearContents
        dic(s) = True
    Next

 End Sub
（マナ） 2023/12/04(月) 21:21:37

 早とちりでした

 Sub test2()
    Dim dic As Object
    Dim r As Range, c As Range, s As String

    Set dic = CreateObject("scripting.dictionary")

    For Each r In Cells(1).CurrentRegion.Rows
        Set c = Union(r.Cells(1), r.Cells(3))
        s = Evaluate("TextJoin(char(9), False," & c.Address & ")")
        If dic.exists(s) Then c.ClearContents
        dic(s) = True
    Next

 End Sub
（マナ） 2023/12/04(月) 23:57:55

皆様ご指南ありがとうございます！
マナ様が提示してくださったコードで組んでみたところ、自分の想定していた通りの
動きをしてくれたので、これで運用が出来そうです。

フォーキー様、まる2021様もありがとうございます！
今後コードを組むときに参考にさせていただきます！
（よっち） 2023/12/05(火) 14:47:46

コメント返信：

[ 一覧(最新更新順) ]

[[20231204193651]] 『複数列の値が重複したデータを、削除ではなく空白』（よっち） ページの最後に飛ぶ

[[20231204193651]]　『複数列の値が重複したデータを、削除ではなく空白』（よっち）　ページの最後に飛ぶ