web-dev-qa-db-ja.com

VBAを使用してExcelでリスト/配列を作成し、列内の一意の名前のリストを取得します

列に一意の名前のリストを作成しようとしていますが、ReDimを正しく使用する方法がわかりません。誰かがこれを完了して、その方法を説明したり、別の方法を提案したりできますか？ /より速い方法。

Sub test()
    LastRow = Range("C65536").End(xlUp).Row
    For Each Cell In Range("C4:C" & LastRow)
        OldVar = NewVar
        NewVar = Cell
        If OldVar <> NewVar Then
            `x =...
        End If
    Next Cell
End Sub

マイデータの形式：

Stack
Stack
Stack
Stack
Stack
Overflow
Overflow
Overflow
Overflow
Overflow
Overflow
Overflow
Overflow
.com
.com
.com

したがって、基本的には一度名前が付けられると、リスト内で後で再びポップアップすることはありません。

最後に、配列は以下で構成されます：

スタック
オーバーフロー
 .com
excelvbaexcel-vbaexcel-2007excel-2010
3
Ryflex

ダグのアプローチの回避策についての私の提案を試すことができます。
ただし、ロジックを使い続けたい場合は、次のことを試すことができます。

Option Explicit

Sub GetUnique()

Dim rng As Range
Dim myarray, myunique
Dim i As Integer

ReDim myunique(1)

With ThisWorkbook.Sheets("Sheet1")
    Set rng = .Range(.Range("A1"), .Range("A" & .Rows.Count).End(xlUp))
    myarray = Application.Transpose(rng)
    For i = LBound(myarray) To UBound(myarray)
        If IsError(Application.Match(myarray(i), myunique, 0)) Then
            myunique(UBound(myunique)) = myarray(i)
            ReDim Preserve myunique(UBound(myunique) + 1)
        End If
    Next
End With

For i = LBound(myunique) To UBound(myunique)
    Debug.Print myunique(i)
Next

End Sub

これは、範囲の代わりに配列を使用します。
また、ネストされたFor Loopの代わりにMatch関数を使用します。
しかし、時差を確認する時間はありませんでした。
それで、私はあなたにテストを任せます。

4
L42

これには配列は必要ありません。次のようなものを試してください：

ActiveSheet.Range("$A$1:$A$" & LastRow).RemoveDuplicates Columns:=1, Header:=xlYes

ヘッダーがない場合は、適宜変更してください。

編集：これは、Collection内の各アイテムが一意のキーを持っている必要があるという事実を利用する従来の方法です。

Sub test()
Dim ws As Excel.Worksheet
Dim LastRow As Long
Dim coll As Collection
Dim cell As Excel.Range
Dim arr() As String
Dim i As Long

Set ws = ActiveSheet
With ws
    LastRow = .Range("C" & .Rows.Count).End(xlUp).Row
    Set coll = New Collection
    For Each cell In .Range("C4:C" & LastRow)
        On Error Resume Next
        coll.Add cell.Value, CStr(cell.Value)
        On Error GoTo 0
    Next cell
    ReDim arr(1 To coll.Count)
    For i = LBound(arr) To UBound(arr)
        arr(i) = coll(i)
        'to show in Immediate Window
        Debug.Print arr(i)
    Next i
End With
End Sub
5
Doug Glancy

FWIW、ここに辞書があります。 MSスクリプトへの参照を設定した後。ニーズに合わせてavInputの配列サイズを調整できます。

Sub somemacro()
Dim avInput As Variant
Dim uvals As Dictionary
Dim i As Integer
Dim rop As Range

avInput = Sheets("data").UsedRange
Set uvals = New Dictionary


For i = 1 To UBound(avInput, 1)
    If uvals.Exists(avInput(i, 1)) = False Then
        uvals.Add avInput(i, 1), 1
    Else
        uvals.Item(avInput(i, 1)) = uvals.Item(avInput(i, 1)) + 1
    End If
Next i

ReDim avInput(1 To uvals.Count)
i = 1

For Each kv In uvals.Keys
    avInput(i) = kv
    i = i + 1
Next kv

Set rop = Sheets("sheet2").Range("a1")
rop.Resize(UBound(avInput, 1), 1) = Application.Transpose(avInput)




End Sub
1
some guy

これは古い質問だと思いますが、もっと簡単な方法を使用します。通常、クエリを実行するか、既存のリストをコピーするなどして、必要なリストを取得し、重複を削除します。この回答では、元の質問と同様に、リストはすでに列C、行4にあると想定します。この方法は、使用しているサイズリストに関係なく機能し、ヘッダーの[はい]または[いいえ]を選択できます。

Dim rng as range
Range("C4").Select
Set rng = Range(Selection, Selection.End(xlDown))
rng.RemoveDuplicates Columns:=1, Header:=xlYes
1
RollTideMike

VB.Net Generics List（Of Integer）に触発されて、私はそのための独自のモジュールを作成しました。多分あなたもそれが役に立つと思うか、あなたは追加の方法のために拡張したいです、例えば。アイテムを再度削除するには：

'Save module with name: ListOfInteger

Public Function ListLength(list() As Integer) As Integer
On Error Resume Next
ListLength = UBound(list) + 1
On Error GoTo 0
End Function

Public Sub ListAdd(list() As Integer, newValue As Integer)
ReDim Preserve list(ListLength(list))
list(UBound(list)) = newValue
End Sub

Public Function ListContains(list() As Integer, value As Integer) As Boolean
ListContains = False
Dim MyCounter As Integer
For MyCounter = 0 To ListLength(list) - 1
    If list(MyCounter) = value Then
        ListContains = True
        Exit For
    End If
Next
End Function

Public Sub DebugOutputList(list() As Integer)
Dim MyCounter As Integer
For MyCounter = 0 To ListLength(list) - 1
    Debug.Print list(MyCounter)
Next
End Sub

コードで次のように使用できます。

Public Sub IntegerListDemo_RowsOfAllSelectedCells()
Dim rows() As Integer

Set SelectedCellRange = Excel.Selection
For Each MyCell In SelectedCellRange
    If IsEmpty(MyCell.value) = False Then
        If ListOfInteger.ListContains(rows, MyCell.Row) = False Then
            ListAdd rows, MyCell.Row
        End If
    End If
Next
ListOfInteger.DebugOutputList rows

End Sub

別のタイプのリストが必要な場合は、モジュールをコピーして、次の場所に保存します。 ListOfLongを使用して、すべてのタイプIntegerをLongに置き換えます。それでおしまい ：-）

1
Jochen H. W.