| |
>▼kakinoki さん：
>他の方法 (Dictionaryオブジェクト）を使って重複をカウント
こんな感じです
'--------------------------------- 標準モジュール
Option Explicit
Sub Try1()
Dim r As Range
Dim v, i As Long, n As Long
Dim u, ss As String
Dim dic As Object
Dim t! '時間計測用
t = Timer()
Set dic = CreateObject("Scripting.Dictionary")
Set r = Range("A2", Cells(Rows.Count, 1).End(xlUp))
v = r.Resize(, 2).Value
n = UBound(v)
ReDim u(1 To n, 1 To 3)
For i = 1 To n
If Len(v(i, 1)) > 0 Then
dic(v(i, 1)) = dic(v(i, 1)) + 1
ss = v(i, 1) & v(i, 2)
u(i, 1) = ss
dic(ss) = dic(ss) + 1
End If
Next
ReDim rev(1 To n, 1 To 2)
For i = 1 To n
If Len(v(i, 1)) > 0 Then
u(i, 2) = dic(v(i, 1))
u(i, 3) = dic(u(i, 1))
End If
Next
r.Offset(, 2).Resize(, 3).Value = u
Debug.Print Timer() - t
End Sub
30,000行のデータに対し実行した結果は 0.46 秒でした。
|
|
![[未読]](./data/excel/image/read_icon.gif){kind=icon}
