9月に作成した「ユーザーフォームのコンボボックスに検索の履歴を表示する」記事でコンボボックスを使用してファイル検索を行うと、同じファイル名の履歴がA列のセルに残ってしまいます。
今回はエクセルの「重複の削除」ボタンをマクロの記録して、作成したコードを「UserForm1」のプログラムに組み込み、ファイル検索と同時に重複するファイル名を削除して検索履歴に残らないようにしたいと思います。
重複の削除のコードを「マクロの記録」で作成する
1.「開発」タブ →「マクロの記録」で記録を開始します。
2. 重複データを調べたい表内の一か所のセルを選択する。ここではセルA1を選択しました。
3.「データ」タブの「データツール」の「重複の削除」をクリックします。
4. 「先頭行をデータの見出しとして使用する」に☑チェックが入っているのを確認して、重複が含まれている列の「検索履歴」に☑チェックを入れて「OK」ボタンを押します。
5. 「記録終了」→「VIsual Basic」を選択して
6. 標準モジュールをダブルクリックしてコードウインドウを開く。
標準モジュールに記録されたコードは次のようになりました。
Sub Macro1()
'
' Macro1 Macro
'
'
Range("A1").Select
ActiveSheet.Range("$A$1:$A$5").RemoveDuplicates Columns:=1, Header:=xlYes
End Sub
A列全体に範囲を広げて処理したいので、次のように「Range(“$A$1:$A$5”)」を「Columns(“A”)」にコードを書き換えます。
Sub Macro1()
'
' Macro1 Macro
'
'
Range("A1").Select
ActiveSheet.Columns("A").RemoveDuplicates Columns:=1, Header:=xlYes
End Sub
重複を削除するコードの貼り付け
「ユーザーフォームのコンボボックスに検索の履歴を表示する」の「UserForm1」をダブルクリックしてコードウインドウを開きます。
マクロの記録で作成した「ActiveSheet.Columns(“A”).RemoveDuplicates Columns:=1, Header:=xlYes」の重複を削除するコードをコピーして「UserForm1」のプログラムの上から11行目に貼り付けます。
Private Sub UserForm_Initialize() 'ユーザーフォームが表示されるタイミングでフォームの内容を準備する。
Dim i As Long
For i = 2 To Cells(Rows.Count, "A").End(xlUp).Row 'A列の2行目からデータがある最後の行まで処理を繰り返す。
ComboBox1.AddItem Cells(i, "A") 'A列のセルの値をコンボボックスに入力します。
Next i
End Sub
Private Sub CommandButton1_Click()
With ThisWorkbook.Worksheets("Sheet1").Cells(Rows.Count, 1).End(xlUp) 'セルにデータがある最終行を取得します。
.Offset(1, 0).Value = ComboBox1.Text 'コンボボックスに入力した値をA列の検索履歴に書き込みます。
End With
ActiveSheet.Columns("A").RemoveDuplicates Columns:=1, Header:=xlYes '検索履歴の重複を削除します。
Dim name As String
name = UserForm1.ComboBox1.Text
Dim ブック As Workbook
Dim Flag As Boolean
For Each ブック In Workbooks '検索したファイルが開いているか調べます。
If ブック.name = name & ".xlsx" Then
Flag = True
End If
Next ブック
If Flag = True Then '検索したファイルが開いていた場合の処理。
MsgBox "「" & name & "」" & "のファイルは既に開いているので最前面に表示します。"
Workbooks(name & ".xlsx").Activate '開いていたファイルを最前面に表示します。
Unload UserForm1 'ユーザーフォームを閉じます。
Exit Sub
Else '検索したファイルが開いていない場合はファイルを開きます。
If Dir(ThisWorkbook.Path & "\フォルダ\" & name & ".xlsx") <> "" Then 'ファイルがフォルダ内にあるか調べます。
Workbooks.Open Filename:=ThisWorkbook.Path & "\フォルダ\" & name & ".xlsx" 'ファイルを開きます。
Unload UserForm1 'ユーザーフォームを閉じます。
Else 'ファイルがフォルダ内に無いときはメッセージを表示します。
Unload UserForm1 'ユーザーフォームを閉じます。
MsgBox "ファイルはフォルダ内にありません。"
UserForm1.Show vbModeless 'ユーザーフォームをモードレスで表示します。
End If
End If
End Sub
これでファイル検索と同時に重複する履歴が削除されるように設定できました。
検索した値が重複していた場合は自動で削除されるのでコンボボックスの表示がすっきりとして、Webブラウザで検索するような感覚で使用できると思います。
