VBA 重複項目を避けて値を取得する方法

Question

VBA初心者です。

エクセル2019で重複項目を避けて値を取得する方法を知りたいです。

エクセルシートのセルC4からC10にそれそれ数字が記入されています。

それぞれ
C4 = 1
C5 = 3
C6 = 3
C7 = 5
C8 = 1
C9 = 7
C10 = 9

で、C4の値から順番に値を取得し、重複しているものは値を取得せず、次の行に進みます。

この例だと「１３５７９」と表示されないとおかしいということです。

僕のイメージとしては、最初可変長配列を２つ用意し(ここでは配列１、配列２とする）Ⅽ４の値を取得し配列１と２の最初の要素に入れる。

C5の値を取得する時に、配列１の全要素と比較し同じ値でなければ、取得するという感じで作っていたのですが、うまくいきません。

別シートに転記してからとかではなく、マクロを実行させれば１回で値を取得できるようにしたいです。

すいませんがよろしくおねがいします。

Sub 試し()
Dim a() As Long　’aという可変長配列変数宣言
Dim b() As Long　’bという可変長配列変数宣言
Dim ws As Worksheet

Set ws = ThisWorkbook.Worksheets(1)
Dim n As Long
Dim k As Long
Dim j As Long
n = 0

Dim r As Long
For r = 4 To 10

    
    If n = 0 Then
    

        'aの配列はｃ列のすべてを取得
        ReDim Preserve a(n)
        a(n) = Cells(r, "C").Value
        k = 0      'bの配列はa列と重複していないものを取得
        ReDim Preserve b(k)
        b(k) = a(n)
        
        GoTo continue
    
    ElseIf n = 1 Then
            
        ReDim Preserve a(n)
        a(n) = ws.Cells(r, "C").Value
            
            
            For j = 1 To n
                If Not a(j) = b(k) Then
                    k = k + 1
                    ReDim Preserve b(k)
                    b(k) = a(n)
                    
                Else
                
                    Exit For
                    
                End If
            
            Next
                    
     ElseIf n >= 2 Then
            
        ReDim Preserve a(n)
        a(n) = ws.Cells(r, "C").Value
            
            
            For j = 0 To n
                If Not a(j) = b(k)  Then
                    k = k + 1
                    ReDim Preserve b(k)
                    b(k) = a(n)
                    
                Else
                
                    Exit For
                
                End If
                
            Next

    End If
continue:

Debug.Print a(n); b(k)

n = n + 1

Next


End Sub

Comments

[meg_]

「うまくいきません。」とは具体的にはどううまくいかなかったのですか？

[dodox86]

重複が除ければいいのでしょうか。例えば[5,3,3,6,1,10,1]の並びであるとき、求める答えが[5,3,6,1,10]でも[10,5,6,1,3]（順番は問わない）でも良いのでしょうか。

[NOVUCHANMAN]

dodox86さん
順番通り重複せず答えを抜き出したいです。

[NOVUCHANMAN]

meg_ざん
下記のコードを実行すると、「１３３５１１１１」になり、「１３５７９」とはならなかったという事です。

Answer 1

重複排除ということなら、連想配列(Dictionary)を使うと簡単です。

Public Sub Sample2()
    Dim a() 'データ配列
    a() = Range("C4:C10").Value
    
    Dim d As Object '重複排除配列(連想配列)
    Set d = CreateObject("Scripting.Dictionary")
    
    Dim i
    For Each i In a
        d(i) = i
    Next

    Debug.Print Join(WorksheetFunction.Transpose(a))
    Debug.Print Join(d.Keys)
End Sub

連想配列を使わずに自分で重複チェックするなら、
重複排除配列に追加する前に、その配列に同じ値がないか確認して、なければ追加するというロジックを組めばいいでしょう。現状のコードをなるべく活かして、

Sub sample()
    Dim a()  'aという可変長配列変数宣言
    Dim b()  'bという可変長配列変数宣言
    Dim ws As Worksheet

    Set ws = ThisWorkbook.Worksheets(1)
    Dim n As Long
    Dim k As Long
    Dim f As Boolean
    Dim i As Variant
    n = 0
    k = 0

    Dim r As Long
    For r = 4 To 10

        ReDim Preserve a(n)
        a(n) = ws.Cells(r, "C").Value
        
        If n = 0 Then
            ReDim Preserve b(k)
            b(k) = a(n)
            k = k + 1
        ElseIf n > 1 Then
            f = False
            For Each i In b
                If i = a(n) Then
                    f = True '重複あり
                    Exit For
                End If
            Next
            If Not f Then '重複なしのとき
                ReDim Preserve b(k)
                b(k) = a(n)
                k = k + 1
            End If            
        End If
        n = n + 1
    Next

    Debug.Print Join(a)
    Debug.Print Join(b)
End Sub

Answer 2

対象の範囲内で重複した文字列を飛ばして配列に格納っていうことで良ければゴリ押しですが

追記:
このコード1行or1列しか対応できません

Sub test()
抽出範囲始点 = "A1"
抽出範囲終点 = "A10"
For i = 0 To Range(抽出範囲終点).Column
    For j = 0 To Range(抽出範囲終点).Row
        If Not 抽出文字列 Like "*," & Range("A1").Offset(j, 0).Value & ",*" Then
            抽出文字列 = 抽出文字列 & "," & Range("A1").Offset(j, 0).Value
        End If
    Next j
Next i

抽出配列 = Split(抽出文字列, ",")

MsgBox (Join(抽出配列))
End Sub