列に一意の名前のリストを作成しようとしていますが、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
ダグのアプローチの回避策についての私の提案を試すことができます。
ただし、ロジックを使い続けたい場合は、次のことを試すことができます。
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
関数を使用します。
しかし、時差を確認する時間はありませんでした。
それで、私はあなたにテストを任せます。
これには配列は必要ありません。次のようなものを試してください:
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
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
これは古い質問だと思いますが、もっと簡単な方法を使用します。通常、クエリを実行するか、既存のリストをコピーするなどして、必要なリストを取得し、重複を削除します。この回答では、元の質問と同様に、リストはすでに列C、行4にあると想定します。この方法は、使用しているサイズリストに関係なく機能し、ヘッダーの[はい]または[いいえ]を選択できます。
Dim rng as range
Range("C4").Select
Set rng = Range(Selection, Selection.End(xlDown))
rng.RemoveDuplicates Columns:=1, Header:=xlYes
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に置き換えます。それでおしまい :-)