Excel VBA同一文字列のポイントを合計

質問

ExcelのVBAのコードを教えてください。
（自分で範囲（Rangeや Cells)のValueの合計などはできるのですが、グダグダ書くとわかりにくくなるので、やりたいこと＝実現したいことのみ書きます）

画像の上図（青い線より上の図）は、現状もっているExcelのファイルです。緑のタイトルがついているE列までが実データです。
似たようなデータ（表）を含むワークシートがこのファイル（Book内）に複数あるのですが、とりあえず処理対象はアクティブな（選択して見ている）ワークシートを対象とします。

作業としては、上図のように6行目にタイトルが並んでおり、そのうちのC列「予約識別子」とD列「ポイント」を集計しています（処理対象はC, D列です）。予約を入れる「クリック」という「行為」に対して予約識別子が立って、それに対してポイントが溜まる、みたいなシステムです。最終行は毎月異なるので、n行としています。n行というのは、月によって100行のときもあれば、10000行を超えることもあります。

処理行為としては、黄色い2列を新たに加えて作業に使っています。
G列に計算式でC列（予約識別子）に重複がある行に1というフラグを建て、次にフィルターでC列の同じ文字列（例えば「CD08」）をフィルターして、Subtotalでそれぞれの文字列（例えば「CD08」）のポイントの合計を算出しています（F列の最初の識別子の行に、合計ポイントを入れている[F7の1000、F9の2500、F12の16000など]）。

最終的に、図の青い線より下のような別シート（新シート）をつくっています。これが成果物です。（シート名はSheet1、Sheet(1)のような、単純につくった順番がわかれば良いです。）

現在計算式とフィルターでやっている処理は、100行程度であれば人の手でもすぐに終わるのですが、10000行を越えていると、時間がかかったり、操作する人によってはヒューマンエラーで計算ミスが起こります。

これをVBAでやりたいのです。
C列（文字列String）の重複をみつけ、D列のポイント数値（これは数字Longです）を合計して、別の新しいシートに左上（A1からで良い）並べたい。
これを実現するコードを教えてください。

なお
（ここから下はマストではないのですが）
集計後の識別子の並びは、重複したものがみつかっても最初に出現した行の文字列を一覧の最初に残したいと思っています。

例えば7行目にある「CD08」（青いセル）は上図の表では1行目、10行目に出現しているのですが、下図のシートでも最初に出現した行（新シートでも最初の行）に入れたい。
上図の12行目にある「E3EA」（ピンク）は、15,19,20行にもありますが、12行目を最初の出現とし、「BF0D」の次に置いています。

これはクリックをされた方が、複数の商品に対して予約行為（クリック）を行えますが、予約時刻を記録している列がすでに削除されてしまっているため、予約順（最初の一手の早押し順）を見える化しておきたいのです。

回答No.1

kagakusuki · ベストアンサー

>シート名はSheet1、Sheet(1)のような、単純につくった順番がわかれば良いです。

という条件を満たす際に、もし古い集計結果のシートが削除されるなどといった理由で、例えば
Sheet(1)、Sheet(3)、Sheet(4)
などの様に途中に抜け(上記の場合はSheet(2))があったり、
Sheet(3)、Sheet(4)、Sheet(2)、Sheet(1)
の様に、順不同に並んでいたりする恐れがある事も考慮しなければならなかったため、シートを作成した順番通りに番号が付く様にする事が結構面倒でしたが、何とか御要望通りになる様にする事が出来ました。

　尚、新しく作成されるシートのシート名は、取り敢えず

「Activeシートのシート名」＋「_集計 (」＋「そのシートが作成された順番」＋「)」

という形式になる様にしております。

Sub QNo9232496_Excel_VBA同一文字列のポイントを合計()

Const OrigItemRow = 6 '元データのシートにおけるタイトル行
Const OrigFirstColumns = "C:E" '元データのシートにおけるコピーする列範囲
Const GroupOrigColumn = "C" '元データのシートにおける「予約識別子」の列
Const NumericOrigColumn = "D" '元データのシートにおける「ポイント数」の列
Const PasteCell = "A1" '集計結果のシートの中の貼り付け先のセル
Const GroupPasteColumn = "A" '集計結果のシートにおける「予約識別子」の列
Const NumericPasteColumn = "B" '集計結果のシートにおける「ポイント数」の列
Const AddString = "_集計(" '元データのシートのシート名を基にして、集計結果のシートのシート名を作る際に付け加える文字列

Dim OrigSheet As Worksheet, OutputSheet As Worksheet, OrigRange As Range, _
buf As Variant, m As Long, n As Long, i As Long

Set OrigSheet = ActiveSheet

With OrigSheet
n = .Cells(Rows.Count, Range(OrigFirstColumns).Column).End(xlUp).Row
If n <= OrigItemRow Then
MsgBox "処理すべきデータが見当たりませんません。" & vbCrLf _
& "マクロを終了します。", vbExclamation, "データ無し"
Exit Sub
End If

m = 1
For i = 1 To Sheets.Count
buf = Sheets(i).Name
If buf Like .Name & AddString & "*#)" Then
buf = Mid(buf, InStrRev(buf, AddString) + Len(AddString))
buf = Left(buf, Len(buf) - 1)
If IsNumeric(buf) Then
If m - buf <= 0 Then m = Int(buf) + 1
End If
End If
Next i

Application.ScreenUpdating = False
Application.Calculation = xlManual

Set OutputSheet = Sheets.Add(after:=Sheets(Sheets.Count))
OutputSheet.Name = .Name & AddString & m & ")"
Set OrigRange = Intersect(.Range(OrigFirstColumns), .Range(OrigItemRow & ":" & n))
.Select
End With
Application.CutCopyMode = False
OrigRange.Copy
With OutputSheet
With .Range(PasteCell)
.PasteSpecial Paste:=xlPasteAll
.PasteSpecial Paste:=xlPasteColumnWidths
Application.CutCopyMode = False
.Resize(OrigRange.Rows.Count, OrigRange.Columns.Count).RemoveDuplicates _
Columns:=Range(PasteCell & ":" & GroupPasteColumn & 1).Columns.Count, Header:=xlYes
End With
With .Range(NumericPasteColumn & Range(PasteCell).Row + 1 & ":" & NumericPasteColumn _
& .Cells(Rows.Count, Range(PasteCell).Column).End(xlUp).Row)
.FormulaR1C1 = "=SUMIF('" & OrigSheet.Name & "'!C" & Columns(GroupOrigColumn).Column _
& ",RC" & Columns(GroupPasteColumn).Column & ",'" & OrigSheet.Name & "'!C" _
& Columns(NumericOrigColumn).Column & ")"
.Parent.Calculate
.Value = .Value
End With
End With

With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

End Sub

お礼

いつもありがとうございます。そしてお世話になります。
望む結果になりました。勉強しないとちょっと分からない部分もありますが、おいおいまた別質問を建てたいと思います。

シートは連番でいいと書いたのは、集計したらすぐにCSVファイルに書き出して保存し、この集計データを別のホストシステムで扱う担当者に渡すフローが別にあるため、計算した結果を同じBook内にワークシートのまま保存することがないためでした。

説明不足で申し訳ありません。