メインコンテンツへスキップ

Word文書の表から重複行を削除するにはどうすればよいですか?

Author: Sun Last Modified: 2025-05-23

Word文書内では、重複する行が含まれている表があり、その中から最初に現れた行だけを残して他の重複行を削除したい場合があります。このような場合、手動で一つずつ重複行を削除することもできますし、VBAコードを使用することもできます。

Wordの表から重複行を削除


Wordの表から重複行を削除

1. 重複行を削除したい表にカーソルを置き、Alt + F11キーを押してMicrosoft Visual Basic for Applicationsウィンドウを有効にします。

2. クリックしてください 挿入 > モジュール 新しいモジュールを作成します。
Insert > Module options in the VBA window

3. 下記のコードをコピーして、新しく作成したモジュールスクリプトに貼り付けます。

VBA: Wordの表から重複行を削除

Public Sub DeleteDuplicateRows2()
'UpdatebyExtendoffice20181011
    Dim xTable As Table
    Dim xRow As Range
    Dim xStr As String
    Dim xDic As Object
    Dim I, J, KK, xNum As Long
    If ActiveDocument.Tables.Count = 0 Then
        MsgBox "This document does not have table(s).", vbInformation, "Kutools for Word"
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Set xDic = CreateObject("Scripting.Dictionary")
    If Selection.Information(wdWithInTable) Then
        Set xTable = Selection.Tables(1)
        For I = xTable.Rows.Count To 1 Step -1
            Set xRow = xTable.Rows(I).Range
            xStr = xRow.Text
            xNum = -1
            If xDic.Exists(xStr) Then
'                xTable.Rows(I).Delete
                For J = xTable.Rows.Count To 1 Step -1
                    If (xStr = xTable.Rows(J).Range.Text) And (J <> I) Then
                        xNum = xNum + 1
                        xTable.Rows(J).Delete
                    End If
                Next
                I = I - xNum
            Else
                xDic.Add xStr, I
            End If
        Next
    Else
        For I = 1 To ActiveDocument.Tables.Count
            Set xTable = ActiveDocument.Tables(I)
            xNum = -1
            xDic.RemoveAll
            For J = xTable.Rows.Count To 1 Step -1
                Set xRow = xTable.Rows(J).Range
                xStr = xRow.Text
                xNum = -1
                If xDic.Exists(xStr) Then
    '                xTable.Rows(I).Delete
                    For KK = xTable.Rows.Count To 1 Step -1
                        If (xStr = xTable.Rows(KK).Range.Text) And (KK <> J) Then
                            xNum = xNum + 1
                            xTable.Rows(KK).Delete
                        End If
                    Next
                    J = J - xNum
                Else
                    xDic.Add xStr, J
                End If
            Next
        Next
    End If
    Application.ScreenUpdating = True
End Sub

VBA pasted into the Module window

4. F5 キーを押してコードを実行すると、すべての重複行が削除されます。
All duplicate rows are removed from the table

注意: 上記のコードは大文字と小文字を区別します。大文字と小文字を区別しないで重複行を削除したい場合は、以下のコードを使用できます。

Public Sub DeleteDuplicateRows2()
'UpdatebyExtendoffice20181011
    Dim xTable As Table
    Dim xRow As Range
    Dim xStr As String
    Dim xDic As Object
    Dim I, J, KK, xNum As Long
    If ActiveDocument.Tables.Count = 0 Then
        MsgBox "This document does not have table(s).", vbInformation, "Kutools for Word"
        Exit Sub
    End If
    Application.ScreenUpdating = False
    Set xDic = CreateObject("Scripting.Dictionary")
    If Selection.Information(wdWithInTable) Then
        Set xTable = Selection.Tables(1)
        For I = xTable.Rows.Count To 1 Step -1
            Set xRow = xTable.Rows(I).Range
            xStr = UCase(xRow.Text)
            xNum = -1
            If xDic.Exists(xStr) Then
'                xTable.Rows(I).Delete
                For J = xTable.Rows.Count To 1 Step -1
                    If (xStr = xTable.Rows(J).Range.Text) And (J <> I) Then
                        xNum = xNum + 1
                        xTable.Rows(J).Delete
                    End If
                Next
                I = I - xNum
            Else
                xDic.Add xStr, I
            End If
        Next
    Else
        For I = 1 To ActiveDocument.Tables.Count
            Set xTable = ActiveDocument.Tables(I)
            xNum = -1
            xDic.RemoveAll
            For J = xTable.Rows.Count To 1 Step -1
                Set xRow = xTable.Rows(J).Range
                xStr = UCase(xRow.Text)
                xNum = -1
                If xDic.Exists(xStr) Then
    '                xTable.Rows(I).Delete
                    For KK = xTable.Rows.Count To 1 Step -1
                        If (xStr = xTable.Rows(KK).Range.Text) And (KK <> J) Then
                            xNum = xNum + 1
                            xTable.Rows(KK).Delete
                        End If
                    Next
                    J = J - xNum
                Else
                    xDic.Add xStr, J
                End If
            Next
        Next
    End If
    Application.ScreenUpdating = True
End Sub

文書内のすべての表から重複行を削除したい場合は、表の外の文書内の任意の場所にカーソルを置き、上記のコードのいずれかを適用します。


Office Tab: Word、Excel、PowerPointにタブインターフェースを提供します。
Navigate through documents using Office Tab
今すぐワークフローを強化しましょう。Office Tabについてさらに詳しく 無料ダウンロード

AI強化されたKutools for Wordで短時間でより多くの作業を実現

Kutools for Wordは単なるツールの集合ではなく、生産性を向上させるために設計されたスマートなソリューションです。AI駆動の機能と最も重要な特徴により、Kutoolsを使えば短時間でより多くの作業を達成できます。

  • コンテンツの要約、書き直し、作成、翻訳を瞬時に実行します。
  • 執筆中に文法、句読点、スタイルに関する提案をリアルタイムで校正します。
  • レイアウト、スタイル、構造を維持しながら、文章を再構成および翻訳します。
  • 40以上の言語に簡単に翻訳でき、グローバルに影響力を広げます。
  • 現在の文書内容に基づいて即時のヘルプとインテリジェントな洞察を受け取ります。
  • セクション区切りを削除する方法など、タスクの完了方法を尋ねると、AIがガイドまたは代行して処理します。
  • 機密情報やプライバシーに関わる情報を数秒で編集し、完全なプライバシーを確保します。
  • すべてのツールはWord内でシームレスに動作し、常に手の届く場所にあります。
  • ドキュメントの作成、改善、翻訳、要約、保護を簡単に行います。
  • リアルタイムで執筆しながら、文法、明瞭さ、トーンを改善します。
  • レイアウトやフォーマットを変更せずに、コンテンツを再構成および翻訳します。
  • セクション区切りを削除する方法など、タスクの完了方法を尋ねると、AIがガイドまたは代行して処理します。
  • すべてのツールはWord内でシームレスに動作し、常に手の届く場所にあります。
Kutools for Wordについてさらに詳しく 今すぐダウンロード
Kutools for Word features

最高のオフィス生産性ツール

Kutools for Word - Wordの体験を100以上の素晴らしい機能で向上させましょう!

🤖 Kutools AI機能: AIアシスタント / リアルタイムアシスタント / スーパー ポリッシュ (形式を保持) / スーパー トランスレート (形式を保持) / AI編集 / AI校正...

📘 文書のマスタリー: ページの分割 / 文書の結合 / 様々な形式で選択をエクスポート (PDF/TXT/DOC/HTML...) / 一括PDF変換...

内容の編集: 複数ファイルにわたる一括検索と置換 /すべての画像をリサイズ / 表の転置 / 表をテキストに変換...

🧹 簡単なクリーンアップ:余分なスペース / セクション区切り / テキストボックス / ハイパーリンクを一掃 / その他の削除ツールは削除グループへ...

創造的な挿入: 千の区切りを挿入 / チェックボックス / ラジオボタン / QRコード / バーコード / 複数の画像 / 挿入グループでさらに発見...

🔍 精密な選択: 特定のページ / / 図形 / 見出し段落を特定 / より多くの 選択 機能でナビゲーションを強化...

スター強化: 任意の場所に移動 / 繰り返しテキストを自動挿入 / 文書ウィンドウ間を切り替え /11 変換ツール...

Kutools and Kutools Plus tabs on the Word Ribbon
👉これらの機能を試してみませんか?今すぐKutools for Wordをダウンロード!🚀