[[20190304231444]]　『セルの指定範囲を重複なしで1列に表示させたい』（みぎかた）　ページの最後に飛ぶ

『セルの指定範囲を重複なしで1列に表示させたい』（みぎかた）

セルの指定範囲を重複なしで1列に表示させたい

過去ログで
ちらばったセル（指定範囲）
を1列に表示をさせるVBAがあったのですが、
重複なしで　1列に表示させることは可能なのでしょうか？

過去の1列に表示　

Option Explicit

Sub AlignDataTo1Col()

    Dim lngRow As Long
    Dim lngCol As Long
    Dim strData As String
    Dim varData As Variant
    Dim lngLop As Long
    Dim rngOutPut As Range

    For lngCol = Selection(1).Column To Selection(Selection.Count).Column
        For lngRow = Selection(1).Row To Selection(Selection.Count).Row
            If Not IsEmpty(Cells(lngRow, lngCol).Value) Then
                strData = strData & vbTab & Cells(lngRow, lngCol).Value
            End If
        Next lngRow
    Next lngCol

    varData = Split(strData, vbTab)

    On Error Resume Next
    Set rngOutPut = Application.InputBox(Prompt:="出力先セルを指定してください。", Type:=8)

    For lngLop = 1 To UBound(varData)
        rngOutPut.Offset(lngLop - 1, 0).Value = varData(lngLop)
    Next

End Sub

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

１列にできたのなら、そのあと「重複の削除」を実行すればよいのでは？
手作業でできるところは、マクロを無理に使わなくてもよいと思いますが。

 Sub test()
    Dim 範囲 As Range
    Dim dic As Object
    Dim c As Range

    Set 範囲 = Range("B3:Z100")

    Set dic = CreateObject("scripting.dictionary")

    For Each c In 範囲
        If c.Value <> "" Then dic(c.Value) = Empty
    Next

    Worksheets.Add.Cells(1).Resize(dic.Count).Value = Application.Transpose(dic.keys)

 End Sub

（マナ） 2019/03/05(火) 00:00

マナさん
ありがとうございます！
データ量が多かったため、1列になるのに時間がかかっていました・・・。
自分の力量が情けないです。

おかげさまでできました！
ありがとうございます！
（みぎかた） 2019/03/05(火) 01:31

コメント返信：

[ 一覧(最新更新順) ]

[[20190304231444]] 『セルの指定範囲を重複なしで1列に表示させたい』（みぎかた） ページの最後に飛ぶ

[[20190304231444]]　『セルの指定範囲を重複なしで1列に表示させたい』（みぎかた）　ページの最後に飛ぶ