Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

48093 / 76732

←次へ　｜　前へ→


	【33576】Re:複雑です、、

ムーン - 06/1/16(月) 9:03 -


	引用なし

	パスワード

▼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、ありがとうございます。
変身遅くなりました、試してみます。

0 hits

▼

【33528】複雑です、、 ムーン 06/1/14(土) 13:44