Excel2000 VBA メッセージボックスでは表示しきれない文字列ををリストボックスに表示

Excel2000 VBA  選択セル値と重複する列範囲の重複文字列をリストボックスに表示

作った理由
メッセージボックスで表示が途切れて全てを表示できない事があったので、全部分を表示できるようにフォームのリストボックスを利用す
（応用範囲は広いかも）

上図のようにD列のマイカテゴリー列の「その他」のセルを選択してからマクロ実行する
マクロを実行しC列のタイトルから一覧をフォームのリストボックスに表示する

事前にフォームを作成する

Sub セル値の列範囲での重複を調べる()
'選択セル値を調べ、列範囲から重複を調べ左側のセル値をリストボックスに追加
'

Dim columnNO, end_row, celCount As Long
Dim strR, buf As String
Dim hani, newR As Range

'選択セルの値を調べる
    strR = Selection
'選択セルの列番号
    columnNO = Selection.Column
'選択セル列の最終行
    end_row = Cells(65536, columnNO).End(xlUp).Row
'検査範囲
    Set hani = Range(Cells(2, columnNO), Cells(end_row, columnNO))
'重複個数
    celCount = WorksheetFunction.CountIf(hani, strR)
'ユーザーフォームの１行目（選択セルの値と個数）と２行目を設定（空白）
    UserForm2.ListBox1.AddItem strR & "  " & celCount & "個"
    UserForm2.ListBox1.AddItem "     "
'選択セル値と同じ値の重複セルを調べ、セルの左側の値をリストボックスに追加
    For Each newR In hani
        If newR = strR Then
            UserForm2.ListBox1.AddItem newR.Offset(0, -1).Value
            UserForm2.ListBox1.AddItem "  "
        End If
    Next newR
'set解除
    Set hani = Nothing
'ユーザーフォームを表示
    UserForm2.Show

End Sub

 

タグ：Excel2000 VBA