VBA内の配列の値を比較し、配列をインクリメントしない、または重複していない場合は値を加算しない

Question

連続していない値のスプレッドシートをループし、その値を残りの配列ディメンションをインクリメントして値を配列に追加する前に、配列に以前に読み込まれた値。病気は以下の少しの例で説明しようとする。

すなわち

Sub ArrayCompare() 
Dim Cntry() As String 
ArrayDim = 5 'The array is dimensioned with another counter that is not  pertinent to this question but typically not greater than 5 in 1 dimension 
ReDim Cntry(ArrayDim) 
Range("C1").Select 
Dim Counter As Integer 

Counter = 8 'In the real spread sheet the counter is dynamic, ive just put this in as an example 

Do Until Counter = 0 
    ArrayCounter = 0 'This is used to compare the array values Cntry(C0) 

    Do Until ActiveCell.Value <> "" 
    If ActiveCell.Value = "" Then 
    ActiveCell.Offset(1, 0).Select 
    Else: End If 
    Loop 

     If Active.Value = Cntry(ArrayCounter - 1) Or ActiveCell.Value = Cntry(ArrayCounter - 2) Or ActiveCell.Value = Cntry(ArrayCounter - 3) Or ActiveCell.Value = Cntry(ArrayCounter - 4) Then 'this doesn't work because the array is not dimensioned to this size yet. 
     ActiveCell.Offset(1, 0).Select 
     Else 
     Cntry(ArrayDim) = ActiveCell.Value 
     ArrayDim = ArrayDim + 1 
     End If 
Counter = Counter - 1 
Loop 
End Sub 

私は私と一緒にとても裸メモリから迅速にこれを行なったし、ご質問があれば私に知らせてください。

Answer 1

コレクションを使用すると、操作が簡単になります。ここでは、格納された値のコレクションをループし、重複が見つかった場合にフラグをマークするサンプルコードを示します。

Sub Add_Value_If_Not_Duplicate() 
Dim My_Stuff As New Collection 
Dim End_of_Data, i, t As Integer 
Dim Unique_Value As Boolean 
End_of_Data = 13    'This will obviously be different for you 
Unique_Value = True 
Dim New_Value As Integer 

'Loops through Column A of sheet 2 to demonstrate the approach 
For i = 1 To End_of_Data       'Iterate through the data in your excel sheet 
    New_Value = Sheet2.Range("A" & i).Value   'Store the new value in a variable 
If My_Stuff.Count > 0 Then      'If you have previously read values 
    'Looping through previously recorded values 
    For t = 1 To My_Stuff.Count 
     If My_Stuff(t) = New_Value Then 
      Unique_Value = False 'If value already exist mark a flag 
      Exit For 
     End If 
    Next 
Else 
            'If you have no previously read values 
End If 
'Add if Unique 
If Unique_Value = True Then      'If value isn't already listed then add it 
    My_Stuff.Add (New_Value) 
End If 
Unique_Value = True        'Reset your 
Next 
    For i = 1 To My_Stuff.Count 
     Sheet2.Range("B" & i) = My_Stuff(i) 'Printing to demonstrate 
    Next 
End Sub