[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『集計』（みっちゃん）
マクロ超初心者です。今までは社内のデータを少しづつ関数だけで処理していました。 こちらで配列やいろんな事をとても判り易く教えてもらって、 以前では考えられなかった膨大な量のデータの処理や、複雑な処理もできるようになって、 みんなで感謝しています。 ありがとうございます! 今、まだ勉強中です。 調べてもどこにも似たようなものがないし、考えても考えても、どうしても わからないことがあるので、また質問に来ました。 よろしくお願いします。
データは30万行もあります。膨大です。 Activesheetだけの処理です。下のような表があります。 関数でいうとSumif関数になります。 ある列の中で同じ種類の合計を最終列+1列に書き出す というものです。 表によって項目が違うので、今まで教えてもらったことを参考にして、分類する列、合計列を選んでもらうようにしています。 もっと勉強して、このブックのシート全部に同じ処理をする・・・というようなこともやってみたいと思っています。 そうするとごちゃごちゃになるので、処理するコードの部分を呼び出す形（？）にしています。
質問は、合計列が何列かある時（Ｆ列、Ｇ列、Ｌ列 など）は、どのようにしたらいいのでしょうか？
A B C D E F G H I J K L [1] 各期の合計 [2] 連番 担当者 住所 番号 合計1 合計2 記号 集8 種類数 枝番 配送計 [3] 1 菅 貴啓 う 5 777 0 HU-8 8,950 1 ｈ-66 0 [4] 2 菊本 清二 お 35 50,000 5 20 0 75 111 [5] 3 菊本 清二 お 35 158 664 635 1 0 [6] 4 前空 浩二 か 6 6,905 88 ｊ-55 12 0 0 [7] 5 美里 雄春 ら 8 45,301 0 95-KK 0 0 ｔｔ 85,100 [8] 6 菅 貴啓 う 5 851 5 [9] 7 美里 雄春 ら 8 165 5 J63 0 ｇｈ-6 59,516 [10] 8 前空 浩二 か 6 520,002 6 88-ｔｙ 231 [11] 9 菅 貴啓 う 5 63 0 ｒｐｐ
Option Explicit
Sub 集計()
Dim BeforTime As Variant, AfterTime As Variant, TimeX As Variant
Dim Aws As Worksheet
Dim Rng As Variant, Rng1 As Variant, Rng2 As Variant
Dim 分類列名 As String, 合計列名 As String
Set Aws = ActiveSheet
Set Rng = Application.InputBox("分類する項目セルを選択してください。", "分類列の取得", "$B$2", Type:=8)
分類列名 = Split(Cells(, Rng.Column).Address, "$")(1)
Set Rng1 = Application.InputBox("合計する列の項目セルを選択してください。", "合計列の取得", "$N$2", Type:=8)
合計列名 = Split(Cells(, Rng1.Column).Address, "$")(1)
BeforTime = Time
処理 Aws, Rng, 分類列名, 合計列名
AfterTime = Time
TimeX = AfterTime - BeforTime
MsgBox "処理が終了しました。" & Chr(13) & " " & Chr(13) & _
"所要時間は" & Minute(TimeX) & "分" & Second(TimeX) & "秒でした。"
End Sub
'------------------------------------------------------------
Sub 処理(Aws, Rng, 分類列名, 合計列名)
Dim dic As Object, Sm As Variant
Dim tbl1 As Variant, tbl2 As Variant, tbl3 As Variant, tbl4 As Variant, tbl5 As Variant, tbl6() As Variant
Dim i As Long, NN As Long, lastRow As Long, lastColumn As Long
With Aws
.Range("1:" & Rng.Row).UnMerge
lastRow = .Cells(.Rows.Count, Rng.Column).End(xlUp).Row
lastColumn = .Cells(Rng.Row, .Columns.Count).End(xlToLeft).Column
tbl1 = .Range(分類列名 & "1:" & 分類列名 & lastRow)
tbl2 = .Range(合計列名 & "1:" & 合計列名 & lastRow)
' tbl3 = .Range(合計列名3 & "1:" & 合計列名 & lastRow)
' tbl4 = .Range(合計列名4 & "1:" & 合計列名 & lastRow)
' tbl5 = .Range(合計列名5 & "1:" & 合計列名 & lastRow)
End With
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To lastRow
Sm = tbl2(i, 1) '+ tbl3(i, 1) + tbl4(i, 1) + tbl5(i, 1)
If Not dic.Exists(tbl1(i, 1)) Then
dic.Add tbl1(i, 1), Sm
Else
dic(tbl1(i, 1)) = dic(tbl1(i, 1)) + Sm
End If
Next i
Erase tbl2 'クリア
' Erase tbl3
' Erase tbl4
' Erase tbl5
'
ReDim tbl6(1 To lastRow, 1 To 1)
For NN = 1 To lastRow
tbl6(NN, 1) = dic(tbl1(NN, 1))
Next NN
Application.ScreenUpdating = False
Aws.Columns(lastColumn + 1).ClearContents '列クリア
Aws.Cells(1, lastColumn + 1).Resize(lastRow, 1).Value = tbl6
Application.ScreenUpdating = True
End Sub
また、このコードでおかしな記述、もっとこういた方がいいとか直すべき点を教えてもらえるとありがたいです。 よろしくお願いします。
＜ 使用 Excel：Excel2007、使用 OS：Windows7 ＞
>>合計列が何列かある時（Ｆ列、Ｇ列、Ｌ列 など）は、どのようにしたらいいのでしょうか？
アップされた現行コードは、まだよく読んでいないのですが、対象の合計列が複数あっても 合計する列は、どれか１つではないのですか？ それとも、F列とG列が選ばれたら、これら2列の領域を 合計対象にしたいということですか？
選ばれた列領域をどう処理するかは、次にまわして、以下のコードは参考になりますか？ ダイアログがでたら、複数のセル領域を Ctrlキーを押しながら選択します。
Sub Test()
Dim r As Range
On Error Resume Next
Set r = Application.InputBox("合計対象列のセルを選んでください（複数選択ＯＫ）", Type:=8)
On Error GoTo 0
If r Is Nothing Then Exit Sub 'キャンセルボタン
MsgBox "選ばれた列領域は " & r.EntireColumn.Address & "でしたよ"
End Sub
（β） 2016/05/08(日) 18:11
あぁ、現在は選んだ合計列（１つだけ）をM列に集計していますが、複数合計列が選ばれれば それぞれ M,N,O,・・・と集約表示したいということでしたかね？
であれば、参考にアップしたコードを組み入れれば、みっちゃんさんなら対応できますね？
>>このコードでおかしな記述、もっとこういた方がいいとか直すべき点を教えてもらえるとありがたいです
コード記述方法はいろいろありますし、細かなレベルでは、人それぞれですので・・・
おかしいというより、参考までに、メモします。
・生成したメモリー領域が膨大なので、Erase tbl2 'クリア といったようなコードをいれておられるんでしょうけど プロシジャレベルで生成した変数は End Sub で、ほぉっておいても消滅します。 また Erase は 配列の【中身】を初期化するだけで、配列そのものは残っています。 いずれにしても、Erase は不要かと思います。
・Application.ScreenUpdating
通常、処理効率アップと画面のちらつきを抑えるために、この手当てをしますが、このコードの場合 書き込みは2回だけですので、処理効率という面では、むしろないほうがいいかもしれません。 ちらつきも、しょせん True になった時に、再描画され、ちらっと動きますので、この面でも不要かな？
・コード云々ではなく、処理の中で1行目のセル結合解除をしてますね。 でも、そのあと、特にセル結合をしているところが見当たりません。 なぜ、結合解除しているのでしょうか？操作者が勝手に結合するケースを想定？ であれば、解除の場所は、ここではなくSub 集計() の最初のほうでやるべきでは？
・選択された領域（Rangeオブジェクト)のアドレス文字列から、列番号を取り出してサブルーティンに渡していますが Rangeオブジェクトのままのほうが、何かと使い勝手がいいかもしれません。
（β） 2016/05/08(日) 18:46
βさま、いつもありがとうございます。 お～！大変参考になり、嬉しいです！一つつつ、直していきます。
それとも、F列とG列が選ばれたら、これら2列の領域を
合計対象にしたいということですか？
そうなのです。2列なら2列、3列なら3列の合計が対象になります。 本当は、データのどこかに列を挿入して、2列なら2列、3列なら3列 の合計を、 サム関数で1列にして、それから上のマクロ実行するのが一番なのですけど、 人手が足らず、サム関数も何もわからない方にお願いするので、合計列を複数選択できる方法がいいかと思い、 質問しました。
教えてもらったコード、試してみました。 なるほど、このようにすればいいのですね！ しかし………どうも、最初に選択した列だけしか反映しないようです。むつかしい…… （みっちゃん） 2016/05/08(日) 19:00
> If Not dic.Exists(tbl1(i, 1)) Then > dic.Add tbl1(i, 1), Sm > Else > dic(tbl1(i, 1)) = dic(tbl1(i, 1)) + Sm > End If
ここは、１行で大丈夫ですよ
dic(tbl1(i, 1)) = dic(tbl1(i, 1)) + Sm
（マナ） 2016/05/08(日) 19:02
こんばんわ。
やりたい事は、以下の通りですか？ 1、条件として指定する内容のあるセルを選んで、その列を条件範囲、セルの内容を条件にする。 2、合計する列を選んで、それぞれの列でSUMIF関数で合計した結果をさらに合計する。
ちょっと思った事ですけど、表示させる行が最下行と言うのは見辛くないですか？ 例えばデータは4行目以降にして、集計結果を3行目に表示させた方が見やすいと思うのですが？
Dictionaryを使う必要は無いですね。 逆に遅くなるだけだと思います。 合計を表示させたいセルにループで対象列全てのSUMIF関数の結果を加算して表示させるだけで良いと思います。 その際も、3行目に関数をセットするなら、行範囲の指定が格段に楽になりますね。
（sy） 2016/05/08(日) 19:17
こう言う事ですか？
L列まで項目があるとして、結果をN2セルに返すようにしています。
Sub test()
Dim r1 As Range, r2 As Range
Dim c As Range
Dim UsedCol As String
Dim Agr As Double
On Error Resume Next
step1:
Set c = Application.InputBox("分類する項目セルを1つ選択してください。", Type:=8)
If c Is Nothing Then Exit Sub
If c.Count > 1 Then
MsgBox "分類に指定する項目セルは、1つだけにして下さい！", vbCritical
GoTo step1
End If
step2:
Set r1 = Application.InputBox("合計対象列のセルを選んでください（複数選択ＯＫ）", Type:=8)
If r1 Is Nothing Then Exit Sub
If r1.Count > 1000000 Then
MsgBox "列全体を指定しないで下さい！", vbCritical
GoTo step2
End If
If Not Application.Intersect(r1, Range(Cells(1, "M"), Cells(Rows.Count, Columns.Count))) Is Nothing Then
MsgBox "範囲外の行は指定しないで下さい！", vbCritical
GoTo step2
End If
On Error GoTo 0
UsedCol = ","
For Each r2 In r1
If InStr(UsedCol, "," & r2.Column & ",") = 0 Then
UsedCol = UsedCol & r2.Column & ","
Agr = Agr + WorksheetFunction.SumIf(c.EntireColumn, c.Value, r2.EntireColumn)
End If
Next
Range("N2").Value = Agr
End Sub
（sy） 2016/05/08(日) 20:40
＞ For NN = 1 To lastRow ＞ tbl6(NN, 1) = dic(tbl1(NN, 1)) ＞ Next NN
＞ Aws.Cells(1, lastColumn + 1).Resize(lastRow, 1).Value = tbl6
（マナ） 2016/05/08(日) 21:15
皆様、ありがとうございます。 マナさま、 教えてもらったところを改善します！ありがとうございます。
集計結果は、重複なしで、dic.keysとdic.itemsを貼り付けることが多いですが
SUMIFに合わせたいということでしょうか
サムイフに合わせたい……うーん、多分そういうことになるのだと思います。 ワークシート関数ではサムイフ関数と同じです。
syさま、 1 は、その通りです。
2、合計する列を選んで、それぞれの列でSUMIF関数で合計した結果をさらに合計する。
もしかして、その方がいいのかな？ こちらのイメージとしては、 それぞれの列でサムイフ関数を出したものを合計するというより、 それぞれの列の合計を出したものを、サムイフ関数にする というイメージでした。 説明が下手で申し訳ないです……
（みっちゃん） 2016/05/08(日) 22:11
なるほど、こういう事ですね。
以下のコードは案なので、集計行を3行目にして、前回の集計結果を消去して、合計対象列の3行目に結果を表示させ、その集計をN2セルに表示させています。
どうしても、最終行が良いのであれば、
Range("3:3").ClearContents
と
Cells(3, r2.Column).Value = Agr
と
Range("N2").Value = WorksheetFunction.Sum(Range("3:3"))
Range("A3").Value = "集計結果"
をの3を最終行に変更すれば、最終行に表示されます。
Sub test()
Dim r1 As Range, r2 As Range
Dim c As Range
Dim UsedCol As String
Dim Agr As Double
On Error Resume Next
step1:
Set c = Application.InputBox("分類する項目セルを1つ選択してください。", Type:=8)
If c Is Nothing Then Exit Sub
If c.Count > 1 Then
MsgBox "分類に指定する項目セルは、1つだけにして下さい！", vbCritical
GoTo step1
End If
step2:
Set r1 = Application.InputBox("合計対象列のセルを選んでください（複数選択ＯＫ）", Type:=8)
If r1 Is Nothing Then Exit Sub
If r1.Count > 1000000 Then
MsgBox "列全体を指定しないで下さい！", vbCritical
GoTo step2
End If
If Not Application.Intersect(r1, Range(Cells(1, "M"), Cells(Rows.Count, Columns.Count))) Is Nothing Then
MsgBox "範囲外の列は指定しないで下さい！", vbCritical
GoTo step2
End If
On Error GoTo 0
Range("3:3").ClearContents
UsedCol = ","
For Each r2 In r1
If InStr(UsedCol, "," & r2.Column & ",") = 0 Then
UsedCol = UsedCol & r2.Column & ","
Agr = WorksheetFunction.SumIf(c.EntireColumn, c.Value, r2.EntireColumn)
Cells(3, r2.Column).Value = Agr
End If
Next
Range("N2").Value = WorksheetFunction.Sum(Range("3:3"))
Range("A3").Value = "集計結果"
End Sub
（sy） 2016/05/08(日) 22:36
そちらのコードでやっていることをみて、要件推測しているところもありますので 勘違いしているところあれば指摘願います。
でも、このセットする集計列ですが、ふつうは、一意の分類項目を列挙して、そこに、その合計値を表示することが多いと思いますけど みっちゃんさんのケース、３０万行のそれぞれの行に、その分類項目の複数列の合計値を表示？
ちょっと違和感もありますが、そういう仕様なんでしょうから。
Sub Test()
Dim mxCol As Long
Dim t As Range
Dim r As Range
Dim catR As Range
Dim totR As Range
Dim catD As Range
Dim totD As Range
Dim vC As Variant
Dim vT As Variant
Dim dic As Object
Dim c As Range
Dim k As String
Dim x As Long
'領域の指定と取得
Set r = Range("B3", ActiveSheet.UsedRange.Cells(ActiveSheet.UsedRange.Count))
Set t = r.Resize(1).Offset(-1)
mxCol = t.Cells(t.Count).Column + 1
On Error Resume Next
Set catR = Application.InputBox("分類する項目セルを選択してください。", "分類列の取得", Type:=8)
On Error GoTo 0
If catR Is Nothing Then Exit Sub 'キャンセルボタン
If catR.Count > 1 Then
MsgBox "分類項目セルは１つだけ選ぶことができます"
Exit Sub
End If
Set catR = Intersect(catR, t)
If catR Is Nothing Then
MsgBox "選ばれたセルはタイトル項目ではありません"
Exit Sub
End If
On Error Resume Next
Set totR = Application.InputBox("合計対象列の項目セルを選んでください（複数選択ＯＫ）", "合計列の取得", Type:=8)
On Error GoTo 0
If r Is Nothing Then Exit Sub 'キャンセルボタン
Set totR = Intersect(totR, t)
If totR Is Nothing Then
MsgBox "選ばれたセルはタイトル項目ではありません"
Exit Sub
End If
'集約処理
Set totD = Intersect(totR.EntireColumn, r)
Set catD = Intersect(catR.EntireColumn, r)
vC = catD.Value
ReDim vT(1 To UBound(vC, 1), 1 To UBound(vC, 2))
Set dic = CreateObject("Scripting.Dictionary")
For Each c In totD
k = catD.Cells(c.Row - totD.Row + 1).Value
dic(k) = dic(k) + c.Value
Next
For x = 1 To UBound(vC, 1)
vT(x, 1) = dic(vC(x, 1))
Next
Cells(2, mxCol).Value = catR.Value & "計"
Cells(3, mxCol).Resize(UBound(vT)).Value = vT
End Sub
（β） 2016/05/08(日) 22:37
よく見たら、
＞ 2、合計する列を選んで、それぞれの列でSUMIF関数で合計した結果をさらに合計する。 ＞もしかして、その方がいいのかな？ ＞こちらのイメージとしては、 ＞それぞれの列でサムイフ関数を出したものを合計するというより、 ＞それぞれの列の合計を出したものを、サムイフ関数にする というイメージでした。 ＞説明が下手で申し訳ないです……
30万行の対象列の数値を1行づつ合計して、最後にSUMIFで条件に合う結果を求めたいと言う事ですか？
でしたら、最終結果は私の 2、の要件と同じになりませんか？ 初めのコードで要件を満たしていると思いますし、まず1行づつ合計する作業が無駄ですね。
ワークシート関数は非常に高速です。 でも1回毎の計算に、毎回対象範囲の配列を相手にするので、集計回数が多くなれば、範囲の格納が1回で済むDictionaryなどの方が速くなります。 今回のケースでは計算実行回数が数回と知れてるので、SUMIFの方が圧倒的に速いです。
集計は、条件に合ったものを重複も含めて集計するのが普通です。 ただSUMIFなんかは殆どの人が使えるので、ここに質問する人が少ないと言うだけですね。 ここに質問する人は、重複を除いた合計を出したいとかの普通のSUMIFとかでは集計できないような難題が多いので、 ここだけ見たらSUMIFで集計してる人の方が少数派になるだけです。
（sy） 2016/05/08(日) 23:06
syさま、 何度も申し訳ないです…… 先ほどは、ｍｏｍｏさまのサンプル範囲を貼り付けるコードが◆？◆？になって使えなかったため、 サンプルがめちゃくちゃになり、結果の表を載せておりませんでした。混乱させてしまい、すみません、お許しを……。 今、やってみたらｍｏｍｏさまのコードできれいに貼りつきました。不思議です。
下の表の Ｌ列が結果列です。
|[A] |[B] |[C] |[D] |[E] |[F] |[G] |[H] |[I] |[J] |[K] |[L]
[1] | | | |各期の合計| | | | | | | |
[2] |連番|担当者 |住所|番号 |合計1 |合計2|記号 |集8 |種類数|枝番 |配送計 |集計
[3] | 1|菅 貴啓 |う | 5 | 777| 0|HU-8 |8,950| 1|ｈ-66 | 0| 1691
[4] | 2|菊本 清二|お | 35 | 50,000| 5| | 20| 0| 75| 111| 50938
[5] | 3|菊本 清二|お | 35 | 158| 664| | 635| 1| | 0| 50938
[6] | 4|前空 浩二|か | 6 | 6,905| 88|ｊ-55| 12| 0| | 0|527226
[7] | 5|美里 雄春|ら | 8 | 45,301| 0|95-KK| 0| 0|ｔｔ | 85,100|190087
[8] | 6|菅 貴啓 |う | 5 | 851| | | | 5| | | 1691
[9] | 7|美里 雄春|ら | 8 | 165| 5|J63 | 0| |ｇｈ-6 | 59,516|190087
[10]| 8|前空 浩二|か | 6 | 520,002| | | | 6|88-ｔｙ| 231|527226
[11]| 9|菅 貴啓 |う | 5 | 63| 0| | | |ｒｐｐ | | 1691
（みっちゃん） 2016/05/08(日) 23:24
βさま、ありがとうございます。 う～～～ん、このように短いコードで出来るなんて感動……大変勉強になります！
1行目が空白行になっている表が多かったため（なぜか上司が勝手に入れてるようです）、
表の1行目に空白行を挿入してやってみると、
If catR Is Nothing Then
MsgBox "選ばれたセルはタイトル項目ではありません"
Exit Sub
End If
このコードが発動？しました。なぜなのか、今からステップインで見てみます。
1行目が空白行ではなかったら、完璧でした。
データのない部分の結果表示列に、0が下にいくつか続いていたので、こちらももう一度ステップインです。
私の上司はもとより、うちの会社は運送業で、今までは個人個人のことをシステムになっているものに入力して終わりでした。 個々のデータを統合、集計したり、ここからまた別の表を作ったり、シートに分けたりするなんてことは、 過去にやったことがありません。何もかもが初めての経験。
でも、このセットする集計列ですが、ふつうは、一意の分類項目を列挙して、そこに、その合計値を表示することが多いと思いますけど
上司にも伝えます。 全てがお手本、勉強になります。ありがとうございます。
（みっちゃん） 2016/05/08(日) 23:57
>>表の1行目に空白行を挿入してやってみると
レイアウトとしては タイトル項目 "連番"がB2にあり、そこから表が始まっていると解釈しています。 1行目は無視していますので空白行であっても、上司が何かセットしていたとしても、2行目の項目を選ぶ限り そういったメッセージはでないと思うのですが？
こちらでは、1行目に何か入っていても、空白行であっても、同じ結果で集計されています。
>>データのない部分の結果表示列に、0が下にいくつか続いていたので、こちらももう一度ステップインです。
具体的には、どの列にデータがない場合でしょうか？
以下余談
>>先ほどは、ｍｏｍｏさまのサンプル範囲を貼り付けるコードが◆？◆？になって使えなかったため、 >>サンプルがめちゃくちゃになり、結果の表を載せておりませんでした。混乱させてしまい、すみません、お許しを……。 >>今、やってみたらｍｏｍｏさまのコードできれいに貼りつきました。不思議です。
こちらの xl2013 でも、ある日、突然 同じ現象が発生。何度かやると、うまくいく場合もあるんですが ほとんどが変な文字２つになってしまいます。 xl2010では、そういうことがないので、文字化けしたら、xl2010のほうで、実行して、貼り付けています。
（β） 2016/05/09(月) 06:39
To sy さん
syさんから、よく Dictionaryの効率の悪さという指摘をされるのを拝見します。 私自身は、そんなに効率が悪いとは思えないのですが、それはそれとして、確かに シート関数の効率は素晴らしいですよね。 シート関数のみならず、シート上で処理するエクセル機能（並び替えやフィルタリング等々）の効率は、へたなコードを ずらずら連ねるより、よっぽど短いコードでかつ早く処理できることが多いですね。
で、今回の みっちゃんさんのレイアウト要件（合計列全行に、その行のコードの合計をセット）にあわせて ちょっと比較してみました。
新規ブックで、TestGenで、A列に項目、B列に数値。これを30万行作成します。 それに対して、TestDがDictionary集計。TestSは集計はSUMIF、同じものがでてくるので、そこはDictionaryからSUMIF集計結果を取り出す。
時間を測定しますと、Dictionary処理のほうが、かなり効率がいいという結果になっています。 もちろん、私が書いたテストロジックのSUMIF処理コードがおそまつなのかもしれませんが。
Sub TestGen()
Dim x As Long
Dim n As Long
Dim a As Long
Dim i As Long
ActiveSheet.UsedRange.Clear
For i = 1 To 300000
a = Int(4 * Rnd + 1)
x = Int(10 * Rnd + 1)
n = Int(100000 * Rnd + 1)
Range("A" & i & ":B" & i).Value = Array(Array("A", "B", "C", "D")(a - 1) & x, n)
Next
End Sub
Sub TestD()
Dim t As Double
Dim dic As Object
Dim v As Variant
Dim d As Variant
Dim c As Range
Dim i As Long
t = Timer
Set dic = CreateObject("Scripting.Dictionary")
With Range("A1", Range("A" & Rows.Count).End(xlUp))
d = .Value
v = .Offset(, 1).Value
End With
For i = 1 To UBound(d, 1)
dic(d(i, 1)) = dic(d(i, 1)) + v(i, 1)
Next
For i = 1 To UBound(v, 1)
v(i, 1) = dic(d(i, 1))
Next
Range("C1").Resize(UBound(v, 1)).Value = v
MsgBox Timer - t
End Sub
Sub TestS()
Dim t As Double
Dim dic As Object
Dim v As Variant
Dim d As Variant
Dim c As Range
Dim i As Long
t = Timer
Set dic = CreateObject("Scripting.Dictionary")
With Range("A1", Range("A" & Rows.Count).End(xlUp))
d = .Value
v = .Offset(, 1).Value
For i = 1 To UBound(d, 1)
If Not dic.exists(d(i, 1)) Then dic(d(i, 1)) = WorksheetFunction.SumIf(.Cells, Cells(i, 1), .Offset(, 1))
v(i, 1) = dic(d(i, 1))
Next
End With
Range("C1").Resize(UBound(v, 1)).Value = v
MsgBox Timer - t
End Sub
（β） 2016/05/09(月) 07:26
>>データのない部分の結果表示列に、0が下にいくつか続いていたので、こちらももう一度ステップインです。
具体的には、どの列にデータがない場合でしょうか？
ここですが、申し訳ございません！ 分類列に空白が入っておりました。ステップインするまでもなく、こちらの間違いでした。すみませんでした。
もう一つの私の課題……
レイアウトとしては タイトル項目 "連番"がB2にあり、そこから表が始まっていると解釈しています。
Ｂ2…… あ……なんてことだ。やはり、質問に載せた表の列名がずれていました。ｍｏｍｏさんのコードの大切さを痛感します。 正しくは、タイトル項目 "連番"は、この表ではＡ2にあります。心よりお詫びします。申し訳ありません。
1行目に空白を入れて、βさんの記述をステップインしました。 項目を選んだはずなのに、 MsgBox "選ばれたセルはタイトル項目ではありません" が出現した訳が判明しました。 空白行を入れたことで、項目行が下にズレたからでした。 項目行は、データファイルによって違います。 先に分類列を選んで、領域を下のようにすると、結果は正しく表示されますが、 そもそも選んだ分類列が間違ってるので、領域が間違って設定され、分類列の MsgBox "選ばれたセルはタイトル項目ではありません" が機能しなくなります……
On Error Resume Next
Set catR = Application.InputBox("分類する項目セルを選択してください。", "分類列の取得", Type:=8)
On Error GoTo 0
Set r = Range(Range("A" & catR.Row + 1), ActiveSheet.UsedRange.Cells(ActiveSheet.UsedRange.Count))
Set t = r.Resize(1).Offset(-1)
mxCol = t.Cells(, t.Count).Column + 1
・ ・ ・ ・
Cells(catR.Row, mxCol).Value = catR.Value & "計"
Cells(catR.Row + 1, mxCol).Resize(UBound(vT)).Value = vT
悩みます。どうすればいいのか……。 （質問とは関係ないですが、上司によると、ExcelはWordと同じ感覚で、上下左右に余白部分が欲しいそうです。 今後、上だけではなくA列側にも知らぬ間に空白列を入れられる可能性大。そこにも対応しなくては……きりないですが、これも勉強です。）
βさまの、< '領域の指定と取得 > といった説明書きが今回もありがたいです。 領域からタイトル行や最終列を取得するコード、インプットボックスのカウントが出来ることや、領域からエラーメッセージが出せること、配列の発想、想像の仕方、 毎回思います。インターネットでは見つけられません。大変勉強になります。
（みっちゃん） 2016/05/09(月) 14:16
なるほど。 ありうるケースですよね。最初はA1から始まる表であっても、なんとなく見た目が窮屈だからということで 列を挿入したり、行を挿入したり。 でも、そういう人は、【見ればわかるだろ！ 表は、ここから始まってるじゃないか！】
対象のシート、A1から始まる正常な（？）形、行を適当に何行か挿入した形、列を何列か挿入した形、 行も列も挿入した形。 こういったシートにして、以下のコードを実行してみてください。 表示される、表の始まり（左上隅）が、どんな挿入を行っても挿入を行わなくとも、ちゃんと取得できていれば このロジックを、アップ済みのコードに組み入れます。
（連番 という文字列を頼りにさがしています。左側の列を優先してさがしています。 もし、上司が 左側に挿入した列のどこかに 連番 という文字列をいれると、だめですけど）
Sub 確認()
Dim pos As Range
With ActiveSheet.UsedRange
Set pos = .Find(What:="連番", After:=.Cells(.Cells.Count), LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchOrder:=xlByColumns)
If pos Is Nothing Then
MsgBox "連番タイトルが見つかりません"
Exit Sub
End If
MsgBox pos.Address
End With
End Sub
（β） 2016/05/09(月) 15:03
βさま、早速 対策を考えてくれて、ありがとうございます。
表示される、表の始まり（左上隅）が、どんな挿入を行っても挿入を行わなくとも、ちゃんと取得できていれば
挿入したり挿入を削除したり、いろいろ試してみましたが、完璧です。"連番"セルのアドレスが正確にメッセージ表示されます。
項目行の事を今の上司に説明してみましたが、はてな？ どうして？ 項目ここからだよ？ と、連番セルの画面を指で抑えたまま納得いかない様子でした。 βさまの想像と、大差ない雰囲気です。 今の上司が例えば納得したとしても、我が社の社員はパソコンに慣れていない同じような人ばかり。 いろんなパターンに合わせて考えることは勉強になるし、こちらで教えてもらうことが楽しいです。
（みっちゃん） 2016/05/09(月) 18:34
それではアップ済みのコードに、領域左上隅を動的に取得する部分を反映したものを。 あわせて、分類項目に数値列を選ぶと、キーマッチしないバグを発見。そこもなおしておきました。
Sub Test2()
Dim mxCol As Long
Dim t As Range
Dim r As Range
Dim catR As Range
Dim totR As Range
Dim catD As Range
Dim totD As Range
Dim vC As Variant
Dim vT As Variant
Dim dic As Object
Dim c As Range
Dim k As String
Dim x As Long
Dim pos As Range
'領域の指定と取得
With ActiveSheet.UsedRange
Set pos = .Find(What:="連番", After:=.Cells(.Cells.Count), LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchOrder:=xlByColumns)
If pos Is Nothing Then
MsgBox "連番タイトルが見つかりません"
Exit Sub
End If
Set r = Range(pos.Offset(1), .Cells(.Count)) 'タイトル行を除いた表の領域
End With
Set t = r.Resize(1).Offset(-1)
mxCol = t.Cells(t.Count).Column + 1
On Error Resume Next
Set catR = Application.InputBox("分類する項目セルを選択してください。", "分類列の取得", Type:=8)
On Error GoTo 0
If catR Is Nothing Then Exit Sub 'キャンセルボタン
If catR.Count > 1 Then
MsgBox "分類項目セルは１つだけ選ぶことができます"
Exit Sub
End If
Set catR = Intersect(catR, t)
If catR Is Nothing Then
MsgBox "選ばれたセルはタイトル項目ではありません"
Exit Sub
End If
On Error Resume Next
Set totR = Application.InputBox("合計対象列の項目セルを選んでください（複数選択ＯＫ）", "合計列の取得", Type:=8)
On Error GoTo 0
If r Is Nothing Then Exit Sub 'キャンセルボタン
Set totR = Intersect(totR, t)
If totR Is Nothing Then
MsgBox "選ばれたセルはタイトル項目ではありません"
Exit Sub
End If
'集約処理
Set totD = Intersect(totR.EntireColumn, r)
Set catD = Intersect(catR.EntireColumn, r)
vC = catD.Value
ReDim vT(1 To UBound(vC, 1), 1 To UBound(vC, 2))
Set dic = CreateObject("Scripting.Dictionary")
For Each c In totD
k = catD.Cells(c.Row - totD.Row + 1).Value
dic(k) = dic(k) + c.Value
Next
For x = 1 To UBound(vC, 1)
vT(x, 1) = dic(CStr(vC(x, 1)))
Next
Cells(t.Row, mxCol).Value = catR.Value & "計"
Cells(t.Row + 1, mxCol).Resize(UBound(vT)).Value = vT
End Sub
（β） 2016/05/09(月) 18:55
こんばんわ。
＞混乱させてしまい、すみません、お許しを……。
＞ある列の中で同じ種類の合計を最終列+1列に書き出す
いえ、私の方が完全に要件を勘違いして、列+1とあるのに、行+1と勘違いしてしまっていました。 大変申し訳ありませんでした。
2、の方の要件は30万行に全てに、条件列の同じ行の内容で抽出する、SUMIFの結果を表示させると言う事だったんですね。
でしたら、 ＞でも1回毎の計算に、毎回対象範囲の配列を相手にするので、集計回数が多くなれば、範囲の格納が1回で済むDictionaryなどの方が速くなります。
これに該当するので、関数案は使えませんでした。 勘違いで申し訳ありませんでした。
To βさん
私の中では、配列でのお詫びの件以降は、Dictionaryが無条件で遅いと言う意識は無いんですが、
ただ私のPCでは、何故か未だに原因が分からないのですが、極端にDictionaryによる格納が遅く、 これは他の方の実行結果と同じコードをコピペさせて貰って検証し、私のPCは人より遅い方なので、 他の手法の場合は1.5倍～2倍くらいしか遅くないのに、Dictionaryだけは何故か3倍～5倍以上遅くなるので、 私のPCでは検証が大変になるので、殆ど使用しないんです。
ただPCの性能だとDictionaryも1.5～2倍くらいになるはずなので、私のPCの何かが悪さしてるだけと認識しています。
Dictionaryが遅いと言うのは、私のPCでは遅いと言う意味で、一応「私の環境では遅いんです。」と、 一文入れていたつもりでしたが、抜けてた時が合ったか、表現がまずかったか、 ご不快にさせてしまったようで、深くお詫び致します。 大変申し訳ありません。
（sy） 2016/05/09(月) 21:24
＞いろんなパターンに合わせて考えることは勉強になるし、こちらで教えてもらうことが楽しいです。
ああ、いま楽しいのなら、おはなししてもご理解いただけないかもしれませんが
いつななにかの折にふと思い出していただけるとさいわいです。
＞今の上司が例えば納得したとしても、我が社の社員はパソコンに慣れていない同じような人ばかり。
ひとさまが一生懸命作ったファイルに勝手に手を加えるのはマナー違反だし
それに、物足りないからと、雪舟の水墨画に色を塗るようなもので、ぶち壊しです。
....という説明をすれば、[納得]はしていただけるのではないかと思います。
[理解]できなくても[納得]できれば行動は変わりますから。
行動が定着したころに[あなたの行動のなにが良いか]説明されれば、理解しやすいです。
（ 佳 ＠雪舟はいいすぎか） 2016/05/10(火) 06:51
むかしシステム担当にわたし自身が言われたんだ。
「へんなことをしたいときは、する前にあたしに連絡してください。
害の無いやりかたをあたしが教えますから。」
あまりにもむかし過ぎて忘れていましたが、言われてうれしかったんだ。
（ 佳 ＠板汚し失礼しました。） 2016/05/10(火) 07:07
syさまの記述の中で、下のInputboxの書き方が大変参考になりました。
はじめ見た時、"step1:" と "step2:" の単語がコメント扱いなのかな？と思いましたが、違いました！
このような繰り返しの方法があるのですね。
今回質問したものではないですが、同僚が作ったコード内で、Inputboxがきちんと終わるまで繰り返しをしたかったらしく、
とても変なやり方でグッチャグチャと長々と記述したものがありました。書き換えよう……。
今後も多くの場面で使わせてもらおうと思います。
On Error Resume Next
step1:
Set c = Application.InputBox("分類する項目セルを1つ選択してください。", Type:=8)
If c Is Nothing Then Exit Sub
If c.Count > 1 Then
MsgBox "分類に指定する項目セルは、1つだけにして下さい！", vbCritical
GoTo step1
End If
・
・
・
On Error GoTo 0
佳さま、貴重な助言をありがとうございます。
ひとさまが一生懸命作ったファイルに勝手に手を加えるのはマナー違反だし
臨機応変に対応していきたいと思います。ありがとうございます。 今回の、項目の上と左に勝手に空白を入れる人がいるかもしれない、という一件ですが、考えたら、項目がいつも２行目とは限らないですし、 βさまに教えてもらった考え方で幅広く更にバージョンアップ。完成しました。
「へんなことをしたいときは、する前にあたしに連絡してください。
害の無いやりかたをあたしが教えますから。」
ぃや～まだ今の自分には、とてもそのようなことを言えるスキルは皆無です、もうやらなくていいといわれかねないです。 我が社のワープロ世代の上司や、その他の社員のマクロに対する認識は何もありません。 自分たちのスキルが低いため、制約したいのは山々ですが、いつもそうすると、”マクロって制約がありすぎて不便だ” となってしまいます。 それは避けたい というのが仲間内（少数）で一致した意見です。ギリギリまで考えて、こちらに質問するかしないかも相談しながら決めています。 回答してくれる先生方の迷惑を省みず、ちょっと変わった無理難題を次々と質問していますが、 必ずみんなで復習し、ギョウテンの新発見の記述は共有しています。これからも どうかよろしくお願いします。
βさま、完璧なコードを、ありがとうございます。（まるで雪舟庭のようです）
ただ、ひとつ質問があります。 （みっちゃん） 2016/05/10(火) 15:55
βさまの Sub Test2() のコードのコメントで、
あわせて、分類項目に数値列を選ぶと、キーマッチしないバグを発見。そこもなおしておきました。
大発見、ありがとうございます！ しかし、なぜ分類列が数字だったら dic((vC(x, 1)) が何もないことになるのか…… それを質問しようとしたのですが、
最初のコードと比較してステップ実行していると、
For x = 1 To UBound(vC, 1)
vT(x, 1) = dic(CStr(vC(x, 1)))
Next
ここに"CStr"が加えられていました。世紀の大発見です。
F1で見ると、【CStr 関数を使用して、数値を String に変換します。】と書いてありました。そして、
ウオッチウインドウで見ると、vC(x, 1)の値は 5 で型が Variant/ Double、
CStr(vC(x, 1))の値は "5" で型が String となっています。
分類列が数字（Double）だと、dicが "え、これ計算する?" みたいなことになるので、文字列に直さないと反応しないということなのでしょうか？
………ほかに、F1を見ると、【CDbl 関数を使用して、式を Double に変換します。】というのもあるらしいです。
合計列がもしかしたら文字列とか Doubleではないものがあるかもしれないので、式ではないですが c.Valueを、
For Each c In totD
k = catD.Cells(c.Row - totD.Row + 1).Value
dic(k) = dic(k) + CDbl(c.Value)
Next
とかにした方がいいのか、しなくてもいいのか……… 教えて下さい。
こだわりすぎて混乱してきました。
（みっちゃん） 2016/05/10(火) 22:56
いやぁ・・・（汗、汗） そんなに難しいことではなくβの完全なチョンボだったんです。 もともと、分類項目列を文字列だと、そう思いこんでいたので、その値を取り出す変数 k を Dim k As String と 何も考えずに、そう宣言していました。
で、番号のような数値列を指定するとマッチせず合計が表示されない！！！
あたりまえですね。元が 35 という数値であっても文字列型のkにいれると "35" 。 この "35" をキーとして dic に格納したので、データの 35 でdicから抽出するとキーがないわけで 戻り値が空白になってしまったという、おそまつでした。
なので、急きょ、35 を Cstr をかけて文字列型の "35" に変換したもので dic から抽出しました。
よく考えると、そんな、とって付けたようなことをせず、Dim k As Variant として vT(x, 1) = dic(vC(x, 1)) はそのままにしておいたほうが まともな対応だったと反省してます。
（β） 2016/05/10(火) 23:16
あぁ、もう１つ、質問があったんですね。
数値に数値を加算する場合は、加算される変数がLong型で、加算するほうがDouble型の範囲の数値の場合はオーバーフローになりますね。 あるいは、加算される変数に、なにかを加算した結果、Long型の範囲を超えた場合もオーバーフロー。
ここで扱っている数値は、セルにある数値で、取り込んでいる変数領域は Variant型なので、 元々セルにあった数値の大きさで、それぞれの型がきまってきます。
で、Long型は 9223372036854775807 まで。 仮に、セルにそれより大きな数字があって、それが Long型の範囲の数字に足しこまれると エラーになりますね。 でも、一般的に、こんな巨大な数字はないと思いますので、忘れてもいいかなと。
ただ、もし、合計する列に文字列があれば、それはやばいですね。エラーになります。 それを避けるには
１．合計列には文字列データは記入しない！
でも、うっかり、そういった列を選択してしまう可能性はありますね、人間ですから。操作ミスですけど。 これをカバーしようとすれば
２．足しこむものを、Val(値) とする。
これで、エラーは防げます。 でも、そうやって取得した数値の合計って意味がないですね。もともと、間違えた列を選んだんでしょうから。 なので、
３．合計前に元の値を IsNumeric で数値かどうかの判定をして、数値でないものが現れれば、メッセージを出して 処理を打ち切り。シートに転記はしない。 こういった処理が妥当かもしれません。
（β） 2016/05/10(火) 23:33
2つ上のご回答、そのようなβさまの教えが、また勉強になります。過分に考えてしまい失礼しました。 とは言っても、型変換関数 というものの存在を初めて知りました。得した気分です。
2回目の なるほど！
上のご回答、オーバーフロー。たまになります。そういうことなのですか。 インターネットなどで読むのと違い、順を追って説明、方法と対策を書いてもらってるので大変わかりやすいです。 ありがとうございます。みんなで共有です。
マクロの記述で、これがダメならこの方法…… と、何通りも考えることが楽しいです。 同僚で比べてみるのも楽しいですし、でもやっぱり一番の楽しみは、 その中で、ベストのものをこちらで教えてもらって、みんなで勉強すること。 また、質問や添削してもらいに来ます。ご迷惑かと思いますが、よろしくお願いします！ （みっちゃん） 2016/05/11(水) 00:26
おはようございます。
＞syさまの記述の中で、下のInputboxの書き方が大変参考になりました。
今回勘違いで板汚ししかしてなかったので、1つでもお役に立てて良かったです。
役に立ってない私がこんな事だけ言うのも何なんですが、(申し訳ありません)
＞１．合計列には文字列データは記入しない！ ＞でも、うっかり、そういった列を選択してしまう可能性はありますね、人間ですから。操作ミスですけど。 ＞これをカバーしようとすれば ＞２．足しこむものを、Val(値) とする。 ＞これで、エラーは防げます。 ＞でも、そうやって取得した数値の合計って意味がないですね。もともと、間違えた列を選んだんでしょうから。 ＞なので、 ＞３．合計前に元の値を IsNumeric で数値かどうかの判定をして、数値でないものが現れれば、メッセージを出して ＞ 処理を打ち切り。シートに転記はしない。 ＞ こういった処理が妥当かもしれません。
これに関してはβさんの言われる通り、矛盾データでの集計より、処理を停止させるのが良いと思いますね。 ただこう言う案件では、一瞬で処理が終わるようなコードは存在しないと思いますので、 例えば対象範囲の一番最後に文字データが存在していた場合は、それまでの実行時間が無駄になり、悲しい事になるので、
If WorksheetFunction.CountA(totD) > WorksheetFunction.Count(totD) Then
MsgBox "合計範囲に文字が含まれているので、処理を中止します！"
Exit Sub
End If
を集計開始の前に記述して、初めにチェックしてあげた方が良いかも知れませんね。
後、合計対象になる列は、入力規則で間違って文字を入力出来ないようにしておいた方が良いと思います。
（sy） 2016/05/11(水) 07:05
>>それまでの実行時間が無駄になり、悲しい事になるので
全くその通りで、実は、CountA + CountBlank と セル数を比較しようとしたんですが CountBlankのほうが、複数領域を受け付けなかったのであきらめていたんです。
CountA と Count の比較でよかったですね！ 普段、関数を使い慣れていないので、こういうときに、なかなかひらめきません。
（β） 2016/05/11(水) 07:39
If WorksheetFunction.CountA(totD) > WorksheetFunction.Count(totD) Then
MsgBox "合計範囲に文字が含まれているので、処理を中止します！"
Exit Sub
End If
このコードは、一瞬にして隠れている文字列が判明するコードですね。
これはまた大発見です。見たことがありません。みんなで共有です。
後、合計対象になる列は、入力規則で間違って文字を入力出来ないようにしておいた方が良いと思います。 Excel画面のデータの所にある入力規則ですね。 エッ これで文字列を入力しないようにできるんですか。恥ずかしいですが知らなくて調べてみました。 なぜかあまりインターネットには載ってなかったので推測してみました。 入力規則の設定を「整数 0～99999999（最大値は適当） 」これでしょうか…… それとも、セルにカーソルを合わせたときに、常時四角いメッセージが出るようにしておくとか…… そのような感じでしょうか。 早速設定します。これで、今から社員各自が入力する金額の文字列は防げます！ ありがとうございます。
（みっちゃん） 2016/05/11(水) 21:12
こんばんわ。
COUNTは範囲内の数字や、数式の結果が数値をカウントします。 COUNTAは文字や数式そのものもカウントします。
なので同じ範囲を比較すれば、文字が含まれていれば、2つの結果が変わるので判別できます。
入力規則は整数を選択して、データを次の値以上にして、最小値を0でも良いです。
そうしておけば、文字は受け付けなくなるので、入力ミスを防げます。
他にも文字数を制限したり、リスト以外の値を制限したり、ユーザー定義を使えば重複の値のみ制限したりと、 様々な入力ミスを防ぐのに役立ちます。
また禁止の値を入力した時のメッセージや、入力時にセルを選択した時に注意事項などのメッセージも設定できますし、
私が一番便利と思うのは、セル単位で日本語入力タブでIMEの設定が出来る事です。 数値だけや半角英文のみのセルは無効にしたり、漢字入力のセルはひらがなにしたり、 自動で切り替わってくれるので、いちいちIMEを切り替えなくて良いのが非常に便利です。
でも万能では無いです。
コピペで別のセルを貼り付けると消えてしまいます。
（sy） 2016/05/11(水) 21:41
入力規則の事、もう一つ書き忘れていました。
入力規則の制限は直接手入力した時にしか働きません。 コピペで消えるのは先述しましたが、 コピペの値のみ貼付では入力規則自体は消えないですけど、 数値のみのセルに文字が貼付可能など、 矛盾した値でもエラーにならずに貼付出来てしまいます。
あくまで直接手入力のミスを防ぐ為だけと思って下さい。
（sy） 2016/05/12(木) 07:47
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.