|
▼kakinoki さん:
>おかげさまで抜群の早出処理できるようになりました
>ただ、生年月日が空白のデータが相当数あり、この時には
>「名前」と「名前+生年月日」が同じになり、2とカウント
>してしまいます。
なるほど、そういう(生年月日が空白の)ケースを考えないと
いけなかったですね
以下で試してみてください。
Sub Try2()
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
If Len(v(i, 2)) > 0 Then '◆ 追加 B列入力のチェック
ss = v(i, 1) & v(i, 2)
u(i, 1) = ss
dic(ss) = dic(ss) + 1
End If
End If
Next
For i = 1 To n
If Len(v(i, 1)) > 0 Then
u(i, 2) = dic(v(i, 1))
If Len(v(i, 2)) > 0 Then '◆ 追加 B列入力のチェック
u(i, 3) = dic(u(i, 1))
End If
End If
Next
r.Offset(, 2).Resize(, 3).Value = u
Debug.Print Timer() - t
End Sub
|
|