Excel VBA質問箱 IV

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

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


2324 / 13644 ツリー ←次へ | 前へ→

【68699】A〜D列が同じ値ならE列合計 希椛(ののか) 11/4/7(木) 16:40 質問[未読]
【68700】Re:A〜D列が同じ値ならE列合計 UO3 11/4/7(木) 17:09 回答[未読]
【68701】Re:A〜D列が同じ値ならE列合計 希椛(ののか) 11/4/7(木) 17:16 質問[未読]
【68702】Re:A〜D列が同じ値ならE列合計 UO3 11/4/7(木) 17:58 発言[未読]
【68703】Re:A〜D列が同じ値ならE列合計 kanabun 11/4/7(木) 21:17 発言[未読]
【68732】Re:A〜D列が同じ値ならE列合計 希椛(ののか) 11/4/12(火) 8:59 お礼[未読]

【68699】A〜D列が同じ値ならE列合計
質問  希椛(ののか)  - 11/4/7(木) 16:40 -

引用なし
パスワード
   いつもお世話になってます。
題名の通りです。
   A列     B列   C列  D列   E列
1  2011/01  9905101000  23   110   123456
2  2011/01  9905101000  23   110    2456
3  2011/02  9906101000  22   130    23456
4  2011/03  9905101000  23   110    1246

のようなデータが無数にあります。
A列〜D列が一致すれば行を統合してE列を合算するプログラムを
お願いします。
上だと1行目2行目が同じですからE1-E2を合計して2行目削除というように
AからDの項目がかぶっている行をまとめるということです。
お忙しいところ申し訳ありませんが宜しくお願い申し上げます。

【68700】Re:A〜D列が同じ値ならE列合計
回答  UO3  - 11/4/7(木) 17:09 -

引用なし
パスワード
   ▼希椛(ののか) さん:

こんにちは

質問内でお使いの「統合」、まさにエクセル機能の「統合」を使えば
(別のシートになりますが)お望みの統合結果が得られます。
作業的には、「区切り位置」等も併用し、いささかめんどうですが、
これをVBAコードにすることもできます。

以下は、「そうではない」方法での統合です。
セルに直接書き込んでいますので、処理効率が悪ければ、もう少し工夫もできます。

Sub Sample()
  Dim dic As Object
  Dim c As Range
  Dim myKey As Variant
  Dim k As Long
  Application.ScreenUpdating = False
  Set dic = CreateObject("Scripting.Dictionary")
  For Each c In Range("A1:A" & Range("A" & Rows.Count).End(xlUp).Row)
    myKey = Join(WorksheetFunction.Index(c.Resize(, 4).Value, 1, 0), vbTab) 'A〜D
    dic(myKey) = dic(myKey) + c.Offset(, 4).Value 'E列の値を足しこみ
  Next
  Cells.ClearContents
  For Each myKey In dic
    k = k + 1
    Cells(k, 1).Resize(, 4) = Split(myKey, vbTab)
    Cells(k, 5).Value = dic(myKey)
  Next
  Application.ScreenUpdating = True
End Sub

【68701】Re:A〜D列が同じ値ならE列合計
質問  希椛(ののか)  - 11/4/7(木) 17:16 -

引用なし
パスワード
   U03さま
早々にありがとうございます。
昇順に並び替える必要はありますか?

【68702】Re:A〜D列が同じ値ならE列合計
発言  UO3  - 11/4/7(木) 17:58 -

引用なし
パスワード
   ▼希椛(ののか) さん:

>昇順に並び替える必要はありますか?

必要はありません。
実行して、結果を確認してみてください。

【68703】Re:A〜D列が同じ値ならE列合計
発言  kanabun  - 11/4/7(木) 21:17 -

引用なし
パスワード
   ▼希椛(ののか) さん:

UO3 さんが考えておられる「セルに都度書き込まない」方法
というのは(たぶんですが)こんなことかと思います。
こうすると
> Application.ScreenUpdating = False '/ True
が不要になります。

Sub Try1()
  Dim r As Range
  Dim v, ss As String
  Dim i As Long, j As Long, k As Long, n As Long
  Dim dic As Object
  
  Set dic = CreateObject("Scripting.Dictionary")
  With Range("A1").CurrentRegion.Resize(, 5)
    Set r = .Resize(, 4)
    v = .Value
    For i = 1 To r.Rows.Count
                  ' [A+B+C+D]結合文字列
      ss = Join(Application.Index(r.Rows(i).Value, 0#))
      
      If dic.Exists(ss) Then '---- [A+B+C+D]が登録済みのとき
        n = dic(ss)
        v(n, 5) = v(n, 5) + v(i, 5) '加算
        
      Else         '----- [A+B+C+D]はじめてのとき
        k = k + 1
        dic(ss) = k      '辞書にkey[A+B+C+D]の行番号登録
        If i > 1 Then     '配列内 行移動
          For j = 1 To 5
            v(k, j) = v(i, j)
          Next
        End If
      End If
    Next
    .ClearContents
    .Resize(k).Value = v
  End With
End Sub

【68732】Re:A〜D列が同じ値ならE列合計
お礼  希椛(ののか)  - 11/4/12(火) 8:59 -

引用なし
パスワード
   長期出張だったもので返信送れてしましもうしわけありません。

みなさんありがとうございました。

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