見出し画像

選択した列から重複なしリストをつくるよ

この説明は、ChatGPTで作成しています。

このプロシージャは、選択した列から重複のないリストを作成し、クリップボードにコピーするものです。

手順の概要

  1. 列番号を取得:現在選択しているセルの列番号を取得します。

  2. Dictionaryオブジェクトにデータを追加:各セルの値を取得し、Dictionaryオブジェクトに追加していきます。このオブジェクトはキーが重複しないため、重複した値は自動的に排除されます。

  3. 結果を配列に格納:Dictionaryオブジェクトから重複のない値を配列に格納します。

  4. クリップボードにコピー:配列の内容をクリップボードにコピーします。

コードの詳細

Sub 選択した列から重複なしリストをつくるよ()
    Dim myDic As Variant
    Dim i As Long
    Dim buf As String
    Dim matome() As Variant
    Dim colNum As Long
    
    Set myDic = CreateObject("Scripting.Dictionary")
    On Error Resume Next
    
    ' 現在選択しているセルの列番号を取得
    colNum = Selection.Column
    
    ' myDicにデータを追加
    For i = 2 To Cells(Rows.Count, colNum).End(xlUp).Row
        buf = Cells(i, colNum).Value
        myDic.Add buf, buf
    Next i
    
    ' matomeにmyDicのItemをすべて格納
    If myDic.Count > 0 Then
        ReDim matome(0 To myDic.Count - 1)
        For i = 0 To myDic.Count - 1
            matome(i) = myDic.Items()(i)
        Next i
    End If
    
    ' クリップボードに結果を貼り付けます
    With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .SetText Join(matome, vbCrLf)
        .PutInClipboard
    End With
    
    Set myDic = Nothing
End Sub

このプロシージャは、Dictionaryオブジェクトを使用して重複を排除し、結果をクリップボードにコピーするため、他のアプリケーションで簡単に利用できます。Excelの基本操作ができれば、簡単に実行できますので、ぜひ試してみてください。


Create a Unique List from Selected Column

This explanation is created by ChatGPT.

This procedure creates a unique list from the selected column and copies it to the clipboard.

Overview of Steps

  1. Get Column Number: Get the column number of the currently selected cell.

  2. Add Data to Dictionary Object: Retrieve the value of each cell and add it to a Dictionary object. Since the Dictionary object does not allow duplicate keys, duplicate values are automatically removed.

  3. Store Results in Array: Store the unique values from the Dictionary object into an array.

  4. Copy to Clipboard: Copy the contents of the array to the clipboard.

Detailed Code

Sub CreateUniqueListFromSelectedColumn()
    Dim myDic As Variant
    Dim i As Long
    Dim buf As String
    Dim matome() As Variant
    Dim colNum As Long
    
    Set myDic = CreateObject("Scripting.Dictionary")
    On Error Resume Next
    
    ' Get the column number of the currently selected cell
    colNum = Selection.Column
    
    ' Add data to myDic
    For i = 2 To Cells(Rows.Count, colNum).End(xlUp).Row
        buf = Cells(i, colNum).Value
        myDic.Add buf, buf
    Next i
    
    ' Store myDic items into matome
    If myDic.Count > 0 Then
        ReDim matome(0 To myDic.Count - 1)
        For i = 0 To myDic.Count - 1
            matome(i) = myDic.Items()(i)
        Next i
    End If
    
    ' Copy result to clipboard
    With CreateObject("new:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
        .SetText Join(matome, vbCrLf)
        .PutInClipboard
    End With
    
    Set myDic = Nothing
End Sub

This procedure uses a Dictionary object to eliminate duplicates and copies the results to the clipboard, making it easy to use in other applications. If you have basic Excel skills, you can easily execute this, so give it a try.


キーワード

#excel #できること #vba #ユニークリスト #重複排除 #クリップボード #データ整理 #データ分析 #ExcelVBA #プログラミング初心者 #列操作 #セル操作 #ディクショナリオブジェクト #データ管理 #自動化 #エクセル #マクロ #プログラミング学習 #新入社員 #初心者向け

この記事が気に入ったらサポートをしてみませんか?