Excel VBA質問箱 IV

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

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


48139 / 76732 ←次へ | 前へ→

【33530】Re:複雑です、、
回答  kobasan  - 06/1/14(土) 16:20 -

引用なし
パスワード
   ▼ムーン さん 今日は。

これでできると思います。

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

0 hits

【33528】複雑です、、 ムーン 06/1/14(土) 13:44 質問
【33530】Re:複雑です、、 kobasan 06/1/14(土) 16:20 回答
【33552】Re:複雑です、、 ponpon 06/1/15(日) 2:13 質問
【33553】Re:複雑です、、 kobasan 06/1/15(日) 8:43 発言
【33555】Re:複雑です、、 ponpon 06/1/15(日) 11:11 お礼
【33577】Re:複雑です、、 ムーン 06/1/16(月) 9:05 お礼
【33576】Re:複雑です、、 ムーン 06/1/16(月) 9:03 お礼
【33551】Re:複雑です、、 Hirofumi 06/1/14(土) 23:35 回答
【33578】Re:複雑です、、 ムーン 06/1/16(月) 9:07 お礼

48139 / 76732 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free