| |
▼kobasan さん：
>▼ムーン さん 今日は。
>
>これでできると思います。
>
>Sub main()
>Dim rngA As Range, r As Range
>Dim Dic As Object
>Dim dkey
> '
> Set rngA = ActiveSheet.Range("A1", Range("A65536").End(xlUp))
> Set Dic = CreateObject("Scripting.Dictionary")
> '
> For Each r In rngA.Cells
> dkey = r.Text & r.Offset(, 1).Text & r.Offset(, 2).Text
> Dic.Item(dkey) = Dic.Item(dkey) + r.Offset(, 3).Text
> Next
> '
> For Each dkey In Dic.keys()
> For Each r In ActiveSheet.Range("A1", Range("A65536").End(xlUp))
> If r.Text & r.Offset(, 1).Text & r.Offset(, 2).Text = dkey Then
> r.Offset(, 4) = Dic.Item(dkey)
> Exit For
> End If
> Next
> Next
> '
> Set Dic = Nothing
> Set rngA = Nothing
>End Sub
kobasan、ありがとうございます。
変身遅くなりました、試してみます。
|
|
ムーン
- 06/1/16(月) 9:03 -
