| |
こんにちは。
【36764】のコードを少し修正して流用すると、下記のような感じです。
Sub sample2()
Dim a, d, di, x
Dim r As Range
Dim Dic As Object
Dim i As Long, j As Long
Dim n As Long
Const c As Long = -3
Set r = Range("d1")
With r
n = .End(xlDown).Row
a = .Offset(, c).Resize(.Offset(, c).End(xlDown).Row, 2).Value
d = .Resize(n).Value
End With
ReDim x(1 To n, 1 To 1)
Set Dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(a)
If Dic.exists(a(i, 1)) Then
Dic(a(i, 1)) = Dic(a(i, 1)) + a(i, 2)
Else
Dic(a(i, 1)) = a(i, 2)
End If
Next i
For Each di In d
j = j + 1
If Dic.exists(di) Then x(j, 1) = Dic.Item(di)
Next di
r.Offset(, 1).Resize(n).Value = x
Set Dic = Nothing
Set r = Nothing
End Sub
また、スレッドは違いますが、検索対象列に重複の値がある場合、
【36764】のコードは重複する最下行の値を持ってきますから
重複する最上行の値を持ってくる場合、（【36749】と同じ仕様）
>Dic(a(i, 1)) = a(i, 2)
この箇所を
If Not Dic.exists(a(i, 1)) Then Dic(a(i, 1)) = a(i, 2)
と変更してください。
|
|
Ned
- 06/4/14(金) 15:23 -
