パソコン

フリーページ

< 新しい記事

新着記事一覧(全201件)

過去の記事 >

2025年02月04日

重複除外

カテゴリ：カテゴリ未分類

Sub 重複除外抽出()

Dim ws1 As Worksheet, ws2 As Worksheet
Dim lastRow As Long, lastCol As Long
Dim dataRange As Range
Dim cell As Range
Dim dict As Object 'Dictionaryオブジェクト
Dim outputRow As Long

'ワークシートの設定
Set ws1 = ThisWorkbook.Sheets("Sheet3") '抽出元シート
Set ws2 = ThisWorkbook.Sheets("Sheet4") '抽出先シート

'Dictionaryオブジェクトの生成
Set dict = CreateObject("Scripting.Dictionary")

'抽出範囲の最終行と最終列を取得
lastRow = ws1.Cells(Rows.Count, "C").End(xlUp).Row 'C列の最終行
lastCol = ws1.Cells(4, Columns.Count).End(xlToLeft).Column '4行目の最終列

'抽出範囲を設定
Set dataRange = ws1.Range("C4", ws1.Cells(lastRow, lastCol))

'抽出先シートの開始行
outputRow = 2

'セルの値を順にチェック
For Each cell In dataRange

'空白セルはスキップ
If cell.Value = "" Then Continue For

'Dictionaryに値が存在しない場合、抽出先シートに書き出す
If Not dict.Exists(cell.Value) Then

dict.Add cell.Value, 1 'Dictionaryに値を登録
ws2.Cells(outputRow, "A").Value = cell.Value '抽出先シートに書き出し
outputRow = outputRow + 1 '次の書き出し行へ
End If
Next cell

'メッセージボックスを表示
MsgBox "重複除外抽出が完了しました。", vbInformation

End Sub

コードの説明:
* ワークシートと変数の宣言:
* ws1: 抽出元のSheet3
* ws2: 抽出先のSheet4
* lastRow: 抽出範囲の最終行
* lastCol: 抽出範囲の最終列
* dataRange: 抽出範囲のセル範囲
* cell: 抽出範囲内の各セル
* dict: 重複チェックに使用するDictionaryオブジェクト
* outputRow: 抽出先シートの書き出し行
* ワークシートの設定:
* 抽出元と抽出先のワークシートを設定します。
* Dictionaryオブジェクトの生成:
* Dictionaryオブジェクトを生成します。Dictionaryは、キーと値のペアを格納するオブジェクトで、重複チェックに利用できます。
* 抽出範囲の最終行と最終列を取得:
* ws1.Cells(Rows.Count, "C").End(xlUp).Row: C列の最終行を取得します。
* ws1.Cells(4, Columns.Count).End(xlToLeft).Column: 4行目の最終列を取得します。
* これらを使って、可変範囲のセルを取得します。
* 抽出範囲を設定:
* 抽出範囲のセル範囲を設定します。
* 抽出先シートの開始行を設定:
* 抽出先シートの書き出し開始行を設定します。
* セルの値を順にチェック:
* For Eachループを使って、抽出範囲内の各セルを順番に処理します。
* 空白セルはスキップ:
* If cell.Value = "" Then Continue For: セルが空白の場合、次のセルへスキップします。
* Dictionaryに値が存在しない場合、抽出先シートに書き出す:
* If Not dict.Exists(cell.Value) Then: Dictionaryに同じ値が存在しない場合、以下の処理を行います。
* dict.Add cell.Value, 1: Dictionaryに値を登録します。
* ws2.Cells(outputRow, "A").Value = cell.Value: 抽出先シートのA列に値を書き出します。
* outputRow = outputRow + 1: 次の書き出し行へ進みます。
* メッセージボックスを表示:
* 抽出処理が完了したことを知らせるメッセージボックスを表示します。
使い方:
* Excelファイルを開き、VBE（Visual Basic Editor）を開きます（Alt + F11）。
* 「挿入」→「標準モジュール」を選択します。
* モジュールに上記のコードを貼り付けます。
* Excelシートに戻り、「Sheet3」と「Sheet4」が存在することを確認します。
* 抽出したいデータがSheet3のC4セル以降に入力されていることを確認します。
* マクロを実行します（VBEでF5キーを押すか、Excelシートで「開発」タブ→「マクロ」からマクロを選択して実行）。
これで、Sheet3のC4セルから連続したセル範囲に入っている内容が重複を除いてSheet4のA2セルから縦に列記されます。

お気に入りの記事を「いいね！」で応援しよう