選択した列から重複なしリストをつくるよ
この説明は、ChatGPTで作成しています。
このプロシージャは、選択した列から重複のないリストを作成し、クリップボードにコピーするものです。
手順の概要
列番号を取得:現在選択しているセルの列番号を取得します。
Dictionaryオブジェクトにデータを追加:各セルの値を取得し、Dictionaryオブジェクトに追加していきます。このオブジェクトはキーが重複しないため、重複した値は自動的に排除されます。
結果を配列に格納:Dictionaryオブジェクトから重複のない値を配列に格納します。
クリップボードにコピー:配列の内容をクリップボードにコピーします。
コードの詳細
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の基本操作ができれば、簡単に実行できますので、ぜひ試してみてください。
参考にしたサイト ※著者の方、ありがとうございました!
Office TANAKA - Excel VBA Tips[重複しないリストを作る(1)]
http://officetanaka.net/excel/vba/tips/tips80.htm
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
Get Column Number: Get the column number of the currently selected cell.
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.
Store Results in Array: Store the unique values from the Dictionary object into an array.
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.
Reference site: Thank you to the author!
Office TANAKA - Excel VBA Tips [Creating a Non-Duplicate List (1)]
http://officetanaka.net/excel/vba/tips/tips80.htm
キーワード
#excel #できること #vba #ユニークリスト #重複排除 #クリップボード #データ整理 #データ分析 #ExcelVBA #プログラミング初心者 #列操作 #セル操作 #ディクショナリオブジェクト #データ管理 #自動化 #エクセル #マクロ #プログラミング学習 #新入社員 #初心者向け
この記事が気に入ったらサポートをしてみませんか?