[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『集計時間短縮させる方法』（許斐）
お世話になります。 何も考えずにすごく簡単にな集計マクロ作成しましたが、 いざ使ってみると非常に時間かかかります（20秒） それはこのコードはこういうものでしょか？ それとも私の作り方が変なのでしょか？？ なんとか集計時間を短縮にできますでしょか？？よろしくお願いします。
Sub 許斐()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim MaxRow As Long ' 最終行
Dim key As String ' 検索キー
Dim c, r As Long
Set ws1 = Worksheets("売上明細") '商品別等一覧表
Set ws2 = Worksheets("11-20") '一年間集計表
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
MaxRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row ' 最終行を求める
' 売上明細を連想配列へ読み込む
With ws1
For r = 2 To MaxRow ' 最終行
key = Format(.Cells(r, 1), "ge.m") & .Cells(r, 4) & .Cells(r, 3) ' 店舗CD & 分類CD
dicT(key) = dicT(key) + .Cells(r, 6) ' 売上額
Next
End With
' 集計シートへの書き出し
With ws2
For c = 6 To 17 ' 列
For r = 5 To 41 ' 行
key = Format(.Cells(4, c), "ge.m") & .Cells(r, 4) & .Cells(r, 5) ' 店舗 & 分類
.Cells(r, c) = IIf(dicT(key) = "", 0, dicT(key))
Next
Next
End With
End Sub
(許斐)
サンプルデータを作るのが面倒なので 動かして確認はしていませんが セルへのアクセスが時間をとっているんじゃないかと思います。
イメージとしては↓な感じで
Sub 許斐_1()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim MaxRow As Long ' 最終行
Dim key As String ' 検索キー
Dim c, r As Long
Dim tbl
Set ws1 = Worksheets("売上明細") '商品別等一覧表
Set ws2 = Worksheets("11-20") '一年間集計表
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
MaxRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row ' 最終行を求める
' 売上明細を連想配列へ読み込む
With ws1
tbl = .Cells(1, 1).Resize(MaxRow, 6).Value
For r = 2 To MaxRow ' 最終行
key = Format(tbl(r, 1), "ge.m") & tbl(r, 4) & tbl(r, 3) ' 店舗CD & 分類CD
dicT(key) = dicT(key) + tbl(r, 6) ' 売上額
Next
End With
' 集計シートへの書き出し
With ws2
tbl = .Cells(1, 1).Resize(41, 17).Value
For c = 6 To 17 ' 列
For r = 5 To 41 ' 行
key = Format(tbl(4, c), "ge.m") & tbl(r, 4) & tbl(r, 5) ' 店舗 & 分類
tbl(r, c) = IIf(dicT(key) = "", 0, dicT(key))
Next
Next
.Cells(1, 1).Resize(41, 17).Value = tbl
End With
End Sub
配列内で処理をするようにすると早く成るかな？
(HANA)
HANA さん
いつもありがとうございます。今回もよろしくお願いします。 すごいです。集計時間1秒。。。。。 ぜんぜん違うのですね。
Sub 許斐() は1セルずつ集計されていました。 Sub 許斐_1() は一気に集計されています。
>With ws1 >With ws2 でそれぞれ処理し >Next > .Cells(1, 1).Resize(41, 17).Value = tbl > End With でいっき集計といった感じでしょか？？
(許斐）
？？
With ws2
tbl = .Cells(1, 1).Resize(41, 17).Value
For c = 6 To 17 ' 列
For r = 5 To 41 ' 行
key = Format(tbl(4, c), "ge.m") & tbl(r, 4) & tbl(r, 5) ' 店舗 & 分類
^^^^^^^行の月日の数式が消えてしまいました。
tbl(r, c) = IIf(dicT(key) = "", 0, dicT(key))
Next
Private Sub Worksheet_Change(ByVal Target As Range)で F4に月を入力後
F5=DATE(YEAR(F4),MONTH(F4)+1,DAY(F4)) F6=DATE(YEAR(G4),MONTH(G4)+1,DAY(G4)) ： になっています。 セルをずらして試してみましたが、だめでした。 前のコードは消えずに計算できたのにな～ぜ～（？？）
（許斐）
あ。。。衝突☆
取り敢えず載せておきましょうね。 ＞前のコードは消えずに計算できたのにな～ぜ～（？？） の部分が書いてありますので。 ちょっと違います。 今回のは、前回仰って居られた「配列」って奴です。
イメージとしては・・・ 許斐さんは、ご自身の机に座っています。 入り口の掲示板にデータが貼り出されています。 許斐さんは、このデータを見ながら集計をして掲示をするのですが。。。
まず、(2, 1)の位置に有るデータが必要なので 入り口まで歩いて行って、(2, 1) のデータを見て戻ります。 次のデータの位置を確認すると、(2, 4)なので 入り口まで歩いて行って、(2, 4) のデータを見て戻ります。 次のデータの位置を確認すると、(2, 3)なので 入り口まで歩いて行って、(2, 3) のデータを見て戻ります。 それらのデータを繋げて key に入れたら 次は (2, 6)の位置に有るデータが必要なので 入り口まで歩いて行って、(2, 6) のデータを見て戻ります。
For r = 2 To MaxRow ' 最終行
key = Format(.Cells(r, 1), "ge.m") & .Cells(r, 4) & .Cells(r, 3) ' 店舗CD & 分類CD
dicT(key) = dicT(key) + .Cells(r, 6) ' 売上額
Next
r=2 の時の処理をするだけで、掲示板と机を４往復しなくてはいけません。
これを10回繰り返すと、40往復です。
シートへ書き出す時も同様ですね。
それでは、入り口まで行った時に その表を
コピーして持って帰ってきたらどうでしょう。
データの表をコピーして持ち帰る。
tbl = .Cells(1, 1).Resize(MaxRow, 6).Value
集計結果を書き出す表をコピーして持ち帰る。
tbl = .Cells(1, 1).Resize(41, 17).Value
そして、この表へ集計結果を書き込んで行き
最後に 掲示する。
.Cells(1, 1).Resize(41, 17).Value = tbl
すると、３回の往復で済んでしまいます。
集計自体は これまでと同じようにやっています。 ただ、毎回セルにデータを見に行ったり セルのデータを書き換えたり するのではなく 配列に取り込んでおいて、そこへ見に行ったり そのデータを書き換えたりしています。 全ての集計が済んだ後に 一度に書き出しているので ＞いっきに集計 と言う感じを受けられたかもしれませんが。。。
前回、直接セルの値を操作して大して時間がかからなかったのは 処理すべきセルの数が少なかったからです。
そうは言っても、そんなに時間がかかる訳では無いので ３往復も５往復も大差ないですが ３往復と１００往復と成ると、差は大きく成りますよね。 （あ、この数字は たとえ話ですよ。）
因みに、
With ws2
tbl = .Cells(1, 1).Resize(41, 17).Value
ここで、A1:AO17の範囲のデータを tbl に取り込んで
.Cells(1, 1).Resize(41, 17).Value = tbl
ここで書き出しているので、
この範囲に数式などが有った場合は値に変わってしまいます。
数式を入れる場合は、その範囲を避けておくのが良いと思います。 実際に集計結果を書き出す範囲は、E5:AO41だと思いますので これと同じ大きさの二次配列を作って、そこへ集計して行き E5セルから書き出しをする。 等。
因みに ＞Dim c, r As Long この「c」は変数の型が書かれて居らず、Variant扱いに成ります。 cも Long に設定するので有れば、cの後ろにも As Long をつけて下さい。
ちょっと気になるんですが ＞If Target.Address <> "F4" Then Exit Sub F4セルには何が有るのですか？ ・・・↑は 月を入れるんですね。＾＾；・・・。
(HANA)
あらら ＞実際に集計結果を書き出す範囲は、E5:AO41だと思いますので じゃないんですね。 F列には数式が・・・？
具体的なレイアウトをご提示下さい。 違う状態を想像してお話をしたり コードを作っても かみ合わないだけですから。
(HANA)
とりあえずイベントでTargetを使っていると思うのですが >Target.Address が "F4" になる事は無いと思います。 If Target.Address(0, 0) <> "F4" Then Exit Sub と、しないと"$"が付くので違ってしまいます。
あと、集計に関して速度を求めるのであれば ネイティブなワークシート関数を使う方が速い場合もありますので お試し下さい。
Sub test()
If Target.Address(0, 0) <> "F4" Then Exit Sub
With Sheets("11-20")
.Range("IV2:IV" & .Cells(.Rows.Count, 1).End(xlUp).Row).FormulaR1C1 = _
"=TEXT(RC1,""ge.m"")&""|""&RC4&""|""&RC3"
End With
With Sheets("売上明細").Range("F5:Q41")
.FormulaR1C1 = _
"=SUMIF('11-20'!C256,TEXT(売上明細!R4C,""ge.m"")&""|""&売上明細!RC4&""|""&売上明細!RC5,'11-20'!C6)"
.Value = .Value
.Replace What:="0", Replacement:="", LookAt:=xlWhole, SearchFormat:=False, ReplaceFormat:=False
End With
Sheets("11-20").Columns("IV").ClearContents
End Sub
（ｍｏｍｏ）
HANA さん
わかりやすい解説ありがとうございます。違いが理解できました。
>tbl = .Cells(1, 1).Resize(41, 17).Value は今まで範囲を指定していしてる。と思いましたが、 入り口にのデータをコピーして机まで持ってきてくれる役割だったんですね。 コードひとつで処理速度がまったく違うのですね。 またひとつ勉強になりました。
＞実際に集計結果を書き出す範囲は、E5:AO41だと思いますので 書き出す集計範囲が F5:Q41 です。
>F5=DATE(YEAR(F4),MONTH(F4)+1,DAY(F4)) >F6=DATE(YEAR(G4),MONTH(G4)+1,DAY(G4)) すみませんまちがいました。
G4=DATE(YEAR(F4),MONTH(F4)+1,DAY(F4)) H4=DATE(YEAR(G4),MONTH(G4)+1,DAY(G4)) です。
F4：Q4は 1年の月があります。 F4に 2009/4/1 入力すると G4～は前のセル 月+1 になる。
集計表シートです。 [D] [E] [F] [G] [H] [I] [J] [K] [L] [4] 項目 分類 H21.4 H21.5 H21.6 H21.7 H21.8 H21.9 H21.10 [5] 1項目 A [6] 2項目 B [7] 3項目 A : 37項目 B
＞Dim c, r As Long Dim c As Long と Dim r As Long の短縮と思ったんのですが、 Dim c と Dim r As Long だったんですね。まだまだ勉強することが多いです。
>If Target.Address(0, 0) <> "F4" Then Exit Sub
はチェンジイベントで↓にしています。
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address(0, 0) <> "F4" Then Exit Sub
Call 許斐
End sub
With ws2
tbl = .Cells(1, 1).Resize(41, 17).Value
→A1：Q41の範囲だと思い（5,6）に変更してみましたが、思い通りの結果得られなかったです。
For c = 6 To 17 ' 列
For r = 5 To 41 ' 行
key = Format(tbl(4, c), "ge.m") & tbl(r, 4) & tbl(r, 5) ' 店舗 & 分類
→ループにtbl入れているので tbl = .Cells(1, 1).
^^^^^^が（5,6）だとおもったのですが、、、、、、。
tbl(r, c) = IIf(dicT(key) = "", 0, dicT(key))
Next
Next
.Cells(1, 1).Resize(41, 17).Value = tbl
End With
(許斐）
ちょっと計算しないといけないんですが。 [A] ・・・・ [D] [E] [F] [G] [H] [I] ・・・・ [Q] [1] ： [4] 項目 分類 H21.4 H21.5 H21.6 H21.7 ・・・・ H22.3 [5] 1項目 A x(1 ,1) x(1 ,2) x(1 ,3) x(1 ,4) ・・・・ x(1 ,12) [6] 2項目 B x(2 ,1) [7] 3項目 A x(3 ,1) ： ： ： [41] 37項目 B x(37 ,1) イメージとしては、F5:Q41の範囲用の変数を 一つ作成しておいて、はめ込む感じです。
Sub 許斐_2()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim MaxRow As Long ' 最終行
Dim key As String ' 検索キー
Dim c As Long, r As Long
Dim tbl As Variant, x As Variant
Set ws1 = Worksheets("売上明細") '商品別等一覧表
Set ws2 = Worksheets("11-20") '一年間集計表
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
MaxRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row ' 最終行を求める
' 売上明細を連想配列へ読み込む
With ws1
tbl = .Cells(1, 1).Resize(MaxRow, 6).Value
For r = 2 To MaxRow ' 最終行
key = Format(tbl(r, 1), "ge.m") & tbl(r, 4) & tbl(r, 3) ' 店舗CD & 分類CD
dicT(key) = dicT(key) + tbl(r, 6) ' 売上額
Next
End With
' 集計シートへの書き出し
With ws2
tbl = .Cells(1, 1).Resize(41, 17).Value
Dim x(1 To 37, 1 To 12)
For c = 6 To 17 ' 列
For r = 5 To 41 ' 行
key = Format(tbl(4, c), "ge.m") & tbl(r, 4) & tbl(r, 5) ' 店舗 & 分類
x(r - 4, c - 5) = IIf(dicT(key) = "", 0, dicT(key))
Next
Next
.Cells(5, 6).Resize(37, 12).Value = x
End With
End Sub
F5:Q41に当てはめる用の配列 x を作成して
Dim x(1 To 37, 1 To 12)
コード内で x にデータを整理して
x(r - 4, c - 5) = IIf(dicT(key) = "", 0, dicT(key))
最後に、F5:Q41の範囲に x を書き出します。
.Cells(5, 6).Resize(37, 12).Value = x
少しややこしいのは これまでは、r と c が 読む番地・書く番地 でそろって居ましたが 変数x を F5 セルから書き出す事を想定している為、ずれてしまう点です。
tbl(5 ,6) と x(1 ,1) が 同じ F5セルの位置を想定する事は 問題なく受け入れられますか？
最初のコードは
.Cells(r, c) = IIf(dicT(key) = "", 0, dicT(key))
でした。tblを使ったコードでは、tblはA1セルが基準だったので
tbl(r, c) = IIf(dicT(key) = "", 0, dicT(key))
.Cells が tbl に変わっただけですが、今回は
x(r - 4, c - 5) = IIf(dicT(key) = "", 0, dicT(key))
行番号がずれます。
(HANA)
momo さん
返信遅くすみません。コードをありがとうございます。 Sumif も使用できたんですね。新発見です。 以前はsumprodctを使用していました。
（許斐）
HANA さん
返信遅くなりすみません。月の数式は消えずに計算されました。
＞tbl(5 ,6) と x(1 ,1) が ＞ 同じ F5セルの位置を想定する事は ＞ 問題なく受け入れられますか？ はい。大丈夫です。表の説明で理解できました。
>With ws2 > tbl = .Cells(1, 1).Resize(41, 17).Value >Dim x(1 To 37, 1 To 12) ←ここの使い方？？？ > For c = 6 To 17 ' 列 > For r = 5 To 41 ' 行
Dimをそこに置くのはわかりやすいため？？ その部分のみにその変数を使用するため？？ でしょか？？
（許斐）
・・・・間違えました。。。 Dim x(1 To 37, 1 To 12) ではなく ReDim x(1 To 37, 1 To 12) のつもりでした。。。
今回は、事前に大きさが決まっているので 先頭に Dim x(1 To 37, 1 To 12) って しておけば良いのですが。。。
ReDim だったら、あの位置にあっても問題ないですか？ お手数ですが 前に二文字、加えておいて下さい。
(HANA)
＞Dim x(1 To 37, 1 To 12) すみません。。。。こういう使い方もあるのかな～？と、、、、 エラーになっていませんのであり？てことですか？
（許斐）
＞エラーになっていませんのであり？てことですか？ えっと、一番上に「x As Variant」が無いですか？ これがあったらエラーになると思いますが。。。
それを消して Dim x(1 To 37, 1 To 12) を残してあるなら、エラーには成らないですね。 でも、そうするなら 上へ移動させておいてください。
Dim x(1 To 37, 1 To 12)・・・静的配列 ReDim x(1 To 37, 1 To 12)・・動的配列
静的配列は、後から大きさを変更出来ませんが 動的配列は、後から大きさを変更出来ます。
最初から大きさが決まっていて変更が無い場合は静的配列 大きさが途中で決まる場合等は、動的配列にしておくことが 多いのではないかと思います。
例えば、今回は12ヶ月分と列数が決まっていますが F列から4行目の数式が入力してある最終列まで と言う大きさを確保したい場合は 途中で大きさが決まるので最初の部分では 「xと言う変数を使うよ」と言う事だけを言っておいて 列数が確定した時点で「xの変数は何列に区切るよ」と 書くことが多いのではないかと思います。
また、諸般の事情で途中で大きさを変更する様な場合は 動的配列にしておく必要が在ります。
(HANA)
HANA さん
ありがとうございます。 ＞Dim x(1 To 37, 1 To 12) を使用して「x As Variant」は入れていませんでした。
＞ReDim x(1 To 37, 1 To 12)・・動的配列 を使用する場合は。「x As Variant」を入れました。 大きさは「37」の数字が変動しますので、ReDimを使用しています。
ようやく理解でいきました。 いつもわかりやすい説明を本当にありがとうございます。ありがとうございます。
(許斐）
＞大きさは「37」の数字が変動しますので えっと、 今は37項目しかないけど、増減がある って事ですか？
(HANA)
同じ集計表が10シートあります。 37～45行ほどです。その都度に変更しようかと思います。
許斐
＞同じ集計表が10シートあります。 と言う事は、シートが20シート在るのですか？ それとも、 "売上明細"(商品別等一覧表)シートは一つで "11-20"（一年間集計表）が後9シート？
また、表の範囲はどの様にして判断すれば良いのでしょう？ 例えば、D5から 行方向はD列の入力が在る最終行まで (D列の最終行からEnd(xlUp) で見つかった行) 列方向はQ列まで とか。
(HANA)
>"11-20"（一年間集計表）が後9シート？ は項目別集計で後９枚あります。
＞例えば、D5から ＞行方向はD列の入力が在る最終行まで ＞ (D列の最終行からEnd(xlUp) で見つかった行) ＞列方向はQ列まで
D5から 行方向はD列の入力が在る最終行まで (End(xldown) で見つかった行) 列方向はQ列までです。
↑にしようと思ったんですが、間に空欄等ある場合も呼びこめますか？ End(xlUp) の場合は 42行目が空欄で 43行目がまた別の集計表があります。のでできないような～？？ といろいろ考えましたが。。。。手動で直してしまいました。
方法がありましたら、助かります。＾＾；； （許斐）
＞42行目が空欄で ＞43行目がまた別の集計表があります。 でしたら、End(xlDown) で決める方法も在りそうに思います。
詳しいイメージが分からないのですが そう言った事で問題無いのでしょうか？
D5セルをアクティブにして、Ctrl + ↓ で 確認してみて下さい。
(HANA)
ありがとうございます。 集計シートは問題なくこのまま使用します。＾＾
日付について教えてください。
例えば
A1 2009/10/1 A2 =TEXT(DATE(YEAR($A$1),MONTH($A$1)-4,1),"yyyy") ←2009と表示されるのに
A3 =DATE(YEAR($A$2),4,1) ← 1905/4/1になってしまうのはなぜでしょか？？
2009/4/1にしたいのですが。。。。。。
（許斐）
＞集計シートは問題なくこのまま使用します。＾＾ えっと、意味が分からないのですが。
End(xlDown)では、上手く行かないし コードはもうコピペで作ったからこのままで良い って事ですか？
それとも、問題ないことが確認出来たのでコードを変更した って事ですか？
＞=DATE(YEAR($A$2),4,1) ← 1905/4/1になってしまうのはなぜでしょか？？ =DATE(2009,4,1)とする事を想定して居られるなら =DATE($A$2,4,1) です。
YEAR($A$2) では、シリアル値が2009の日 ＝ 1905/7/1 の 年 → 1905年 ですから、1905/4/1 に成ります。
(HANA)
＞End(xlDown)では、上手く行かないし
＞ コードはもうコピペで作ったからこのままで良い って事ですか？
すみません。そのとおりです＾＾；；
With ws2
MaxRow = .Range("D" & Rows.Count).End(xlDown).Value ' 最終行を求める
tbl = .Cells(1, 1).Resize(41, 17).Value
ReDim x(1 To MaxRow, 1 To 12) ←この使い方NGですか？？
For c = 6 To 17 ' 列
For r = 5 To MaxRow ' 行
key = Format(tbl(4, c), "ge.m") & tbl(r, 4) & tbl(r, 5) ' 店舗 & 分類
x(r - 4, c - 5) = IIf(dicT(key) = "", 0, dicT(key))
Next
Next
.Cells(5, 6).Resize(37, 12).Value = x
End With
したのですが、有効範囲にありませんと。。
>=DATE($A$2,4,1) おお！直りました。ありがとうございます。
（許斐）
Ｑ１
Range("D" & Rows.Count)
とは、2003迄の場合どのセルの事か。
Ｑ２
「Sub 許斐_2()」の所で私が載せた表で言うと
MaxRow = Range("D41").Value としたとき
MaxRowには何が入るか。
Ｑ３ 表が41行目まで有った場合xの行数は何行分必要か。
ステップインで実行して 思った様に成っているか 確認して居ますか？
(HANA)
あ！間違いましたね＾＾;;;
With ws2
MaxRow = .Range("D5").End(xlDown).Row ' 最終行を求める
tbl = .Cells(1, 1).Resize(MaxRow, 17).Value
ReDim x(1 To MaxRow, 1 To 12)
For c = 6 To 17 ' 列
For r = 5 To MaxRow ' 行
key = Format(tbl(4, c), "ge.m") & tbl(r, 4) & tbl(r, 5) ' 店舗 & 分類
x(r - 4, c - 5) = IIf(dicT(key) = "", 0, dicT(key))
Next
Next
.Cells(5, 6).Resize(MaxRow, 12).Value = x
End With
37の場所をすべてMaxRowにしたところうまく合計できました。
＞.Range("D" & Rows.Count).End(xlDown).Value
^^^^^^^^^^①はエクセルの最終行からカウントされていたんですね。65336？
(xlUp)なので①の値が65336
(xlDown）にすると①が1行目からカウントすると思っていました。
①自体がエクセル最終行（65336行目から）からカウントでしたね。
説明がおかしい（？？）
（許斐）
＞①はエクセルの最終行からカウントされていたんですね。65336？ の「から」と書いてあるイメージがよく分かりませんが ちょっと違うんじゃないかと思います。
例えば、Range("A1:B10").Rows.Count は
A1:B10の範囲の行数なので「10」です。
前に何も付いていない場合
全てのセルの範囲の行数をカウントし
2003迄であれば 65336 に成ります。
Range("D" & Rows.Count).End(xlUp)
と書いてあった場合
D65336セル【から】上方向への最終端セルです。
＞Ｑ３ ＞表が41行目まで有った場合xの行数は何行分必要か。 に関しては、どうですか？
(HANA)
＞Ｑ３ 37行。。。？？
＞D65336セル【から】上方向への最終端セルです。 なるほどです。
(許斐）
37行ですよね。 でも ＞ReDim x(1 To MaxRow, 1 To 12) だと、41行分在りますし ＞.Cells(5, 6).Resize(MaxRow, 12).Value = x 41行分書き出していますよ？
ReDimの方は少々多くても良いですが 5行目から41行分のデータが書き変わると 残しておく必要があるセルのデータが 消えてしまう（書き変わる）可能性が在ります。
(HANA)
う～（T0T) データがない・・・・・ 自動に行取得は誤差がありますね・・・ 書き換えてもあまり意味がない？？
ctrl+↓ではちゃんといっています。 なぜこんな誤差が（？？） （許斐）
う～ん。。。分かりませんか。。。
＞＞Ｑ３ ＞37行。。。？？ どうやって計算して、37を求めたんですか？
難しく考えなくても ReDim x(1 To 【求めた方法】, 1 To 12) .Cells(5, 6).Resize(【求めた方法】, 12).Value = x で良いと思いますが。
(HANA)
あ！ ＞＞Ｑ３
[A] ・・・・ [D] [E] [F] [G] [1] ： [4] 項目 分類 H21.4 H21.5 [5] 1項目 A x(1 ,1) で For r = 5 To 41 ' 行は [A] ・・・・ [D] [E] [F] [G] [1] ： [4] 項目 分類 H21.4 H21.5 [5] 1項目 A (5 ,6)
なので、これを
With ws2
MaxRow = Range("D5").End(xlDown).Row ' 最終行を求める
tbl = .Cells(1, 1).Resize(MaxRow, 17).Value
ReDim x(1 To MaxRow, 1 To 12)
For c = 6 To 17 ' 列
For r = 5 To MaxRow ' 行
key = Format(tbl(4, c), "ge.m") & tbl(r, 4) & tbl(r, 5) ' 店舗 & 分類
x(r - 4, c - 5) = IIf(dicT(key) = "", 0, dicT(key))
Next
Next
.Cells(5, 6).Resize(MaxRow - 4, 12).Value = x ←ここをkeyと同じすればOK??
End With
（許斐）
＞keyと同じすれば と言う発想よりも、 ここのイメージもちょっと違うような気もしますが。 5行目から始まるので E列の項目が41行目まで在ったら 41-4 = 37 行分 処理する行数がある と考えた方が良いと思いますが。
よって、xとして 確保しておかなくてはいけない行数はMaxRow - 4 で シートに書き出す時も MaxRow - 4 行分を書き出す。
(HANA)
＞41-4 = 37 行分 処理する行数がある ＞ と考えた方が良いと思いますが。 なるほどです。（－ｘ－）
イメージが違うけど 答えは合っている？ 何か微妙ですね＾＾；；
MaxRow - 4にしたのは
ReDim x(1 To 37, 1 To 12)
と For r = 5 To 41
の誤差が4行なので。。。と単純に考えました。
(許斐）
HANA さん
ありがとうございます。 すべてのシート自動に問題なく集計できました。
お蔭様で何とか完成です。また何かありましたら、 よろしくお願いします。 m(_ _)m
（許斐）
やっぱり ＞MaxRow - 4にしたのは ＞ReDim x(1 To 37, 1 To 12) ＞ と For r = 5 To 41 ＞の誤差が4行なので。。。と単純に考えました。
の説明だと「たまたま合った」って気がするのですが・・・
どうして For r = 5 To MaxRow ' 行 と x(r - 4, c - 5) ではなく ReDim x(1 To 37, 1 To 12) なんですか？
・・・まぁ、私が「違う様に感じる」だけで 問題ないのかも知れませんが。
それよりも、 key = Format(tbl(4, c), "ge.m") & tbl(r, 4) & tbl(r, 5) ' 店舗 & 分類 が、売上明細に無かった場合にエラーになって止まりそうに思いますが 止まりませんか？
また、
＞すべてのシート自動に問題なく集計できました。
と言うのは、コードを9個複製して
Set ws2 = Worksheets("11-20") '一年間集計表
を変えた物を沢山作った
なんて事は無いですよね？
(HANA)
すみません私の説明下手でコンランさせてしまいましたね。
えと tbl(5,6) と x(1,1) をマイナスすると(4,5)行差？になり HANAさんがx(r-4,c-5)したので 書き出す時も行差をマイナスすれば出来るかな～と考えたのです。
for r = 5 to maxrow
とredim(1 to maxrow) は私の頭の中では
↑ 5-1=4になってました (汗
間違いですか？
あと 出来たコードは各9枚のシートにコピーして、シート名変更して使用しました。
項目がない時エラーに成りますね。。。。 エラーメッセージ？作成せねば。。。
許斐
＞for r = 5 to maxrow ＞とredim(1 to maxrow) は私の頭の中では ＞ ↑ 5-1=4になってました (汗 ＞間違いですか？ 済みませんが、何を仰りたいのか良く分かりません。 ご説明だけが上手く行っていないのかもしれませんが。
＞HANAさんがx(r-4,c-5)したので ＞書き出す時も行差をマイナスすれば出来るかな～と考えたのです。 私が居なかったらどうするんです。（笑）
例えば、 Aと言う箱に 赤い玉が入っています。 Bと言う箱に、Aの箱と同じ色の玉（赤い玉）を入れました。 Cと言う箱に、それらと同じ色の玉を入れることに成ったとき Bの箱に赤い玉が入っているから、赤を入れる。・・・(1) Aの箱に赤い玉が入っているから、赤を入れる。・・・(2) どちらも同じ結果になりますが、 【そもそも】Bの箱にどうして赤い玉が入っているか を考えると、Aの箱に赤い玉が入っていたからなので (2)と言っていただけると すっきりしました。
-4 をするのは ＞tbl(5,6) と x(1,1) をマイナスすると(4,5)行差？・・[1] なんですが、どうしてそう成るのかと言うと ＞＞5行目から始まるので・・・・・・・・・・・・・・・・[2] ＞＞E列の項目が41行目まで在ったら ＞＞41-4 = 37 行分 処理する行数がある ですよね？
xの行数 ＝ 処理するデータの件数 です。 それらの数と、maxrowがどうして一致しないかと言うと 1:4行目はデータではないのに、maxrowの中に含まれているからです。 maxrow から、データの件数を得ようと思ったら データではない行数分を、マイナスしなくてはいけません。
「分かってる。大丈夫」って事なら この話は、私の思い違いでしょうから終わりにしてください。
＞出来たコードは各9枚のシートにコピーして、シート名変更して使用しました。 どうして肝心な所でこんな事をしますかね。。。
前の時も、 同じコードが二つあったら 一箇所の変更で、二つのコードの変更が必要になるので やらない方がよい と言う話をしたと思いますが。 それと同じです。
＞エラーメッセージ？作成せねば。。。 これを追加するにしても、今回は9個コピーしたので 10個のコードを変更って事ですよね。
これこそ ws2 に アクティブシートを Set する事にして シートモジュールからCallすれば良いと思いますが。
標準モジュールにコードを置いた場合 シート名が明記されていないときは アクティブシートのセルが対象ですから Set する必要も無いと思いますが。
(HANA)
>-4 をするのは ＞tbl(5,6) と x(1,1) をマイナスすると(4,5)行差？・・[1] >なんですが、どうしてそう成るのかと言うと ＞＞5行目から始まるので・・・・・・・・・・・・・・・・[2] ＞＞E列の項目が41行目まで在ったら ＞＞41-4 = 37 行分 処理する行数がある >ですよね？ なるほど。そう考えたほうがわかりやすいです。＾＾
＞ws2 に アクティブシートを Set する事にして ＞シートモジュールからCallすれば良いと思いますが。
>一箇所の変更で、二つのコードの変更が必要になるのでやらない方がよい 前回のレスですね。今回はシート。。。。（ｘ～ｘ）
>ws2 に アクティブシートを Set する事にして >シートモジュールからCallすれば良いと思いますが。 イメージわかないのですが？？
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wb As Workbook
Dim strFnm As String
Dim ws1 As Worksheet
Dim ws2 As Worksheet
If Target.Address(0, 0) <> "F4" Then Exit Sub
Set ws1 = Worksheets("売上明細").Activate '商品別等一覧表
Set ws2 = Worksheets("11-20").Activate '一年間集計表
Call 許斐_2
MsgBox "集計終わりました。"
End Sub にするていうことですか？？ その際 許斐_2 の ｗ1 とｗ2 は。。。。？今現在エラーになっています。。。
(許斐）
現在では
＞Set ws2 = Worksheets("11-20").Activate '一年間集計表
ここだけがそれぞれ違う~~~~~~~~~
んですよね？
(HANA)
＞Set ws1 = Worksheets("売上明細").Activate '商品別等一覧表
^^^^^^^^
＞Set ws2 = Worksheets("11-20").Activate '一年間集計表
^^^^^^^
すみません両方違います。
練習として一つのbookにしていますが、実際は二つのbookです。
Set ws1 = Workbooks("date.xls").Sheets("売上明細") '商品別等一覧表
集計表が
Set ws2 = Workbooks("集計.xls").Sheets("11-20") '一年間集計表
～
Set ws2 = Workbooks("集計.xls").Sheets("15-20") '一年間集計表
Set ws1 = Workbooks("date.xls").Sheets("売上明細2") '商品別等一覧表
集計表が
Set ws2 = Workbooks("集計.xls").Sheets("16-20") '一年間集計表
～
Set ws2 = Workbooks("集計.xls").Sheets("20-20") '一年間集計表
です。ややこしくてすみません ＞＜
(許斐）
ん？
＞＞＞同じ集計表が10シートあります。 ＞＞と言う事は、シートが20シート在るのですか？ ＞＞それとも、 ＞＞"売上明細"(商品別等一覧表)シートは一つで ＞＞"11-20"（一年間集計表）が後9シート？
の質問に対して
＞＞"11-20"（一年間集計表）が後9シート？ ＞は項目別集計で後９枚あります。
って事でしたよね？
ですから、どこのブックに在っても良いのですが 商品別等一覧表が一つと 項目別集計が９つ在るのかと思ってましたが
商品別等一覧表が二つあって、 一年間集計表が５つずつ在る？
雰囲気では、一年間のデータが分かれているだけみたいですが それなら、一つにまとめておいた方が良いと思いますが。
(HANA)
>商品別等一覧表が二つあって、 >一年間集計表が５つずつ在る？ はいそうです。
>雰囲気では、一年間のデータが分かれているだけみたいですが >それなら、一つにまとめておいた方が良いと思いますが。
う～ん。。。。
では "売上明細" 商品一覧 "11-20" 年間集計表
"売上明細2" 商品一覧 "15-20" 年間集計表
の場合のアクティブシート作成方法を教えていただきますとうれしいです。
（許斐）
１．現在出来ているコードを載せて下さい ２．年間集計表の名前がどうなっていたら どちらの商品一覧表を見に行けば良いのか 教えて下さい ３．年間集計表のシート名が年が変わることで変わるのなら どの部分が変わるのか教えて下さい
因みに、前回も書きましたが シート名を指定しない場合、アクティブシートに対して処理がされます。
(HANA)
>２．年間集計表の名前がどうなっていたら,.....。
年間データが
①Workbooks("date.xls").Sheets("売上明細") の場合
②集計表 Workbooks("集計.xls").Sheets("11-20") になります。
年間データが
③Workbooks("date.xls").Sheets("売上明細2") の場合
④集計表 Workbooks("集計.xls").Sheets("15-20") になります。
①と③同じbookです ②と④同じbookです
>３．年間集計表のシート名が年が変わることで変わるのならどの部分が変わるのか教えて下さい シート名は変わりません。
>１．現在出来ているコードを載せて下さい
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wb As Workbook
Dim strFnm As String
Dim ws1 As Worksheet
Dim ws2 As Worksheet
If Target.Address(0, 0) <> "F4" Then Exit Sub
' ファイルを開く
strFnm = ThisWorkbook.Path & "\date.xls"
Set wb = GetObject(strFnm)
wb.Windows(1).Visible = True
ws1 = ActiveWorkbooks("date.xls").Sheets("売上明細")
Call 許斐_2
MsgBox "集計終わりました。"
End Sub
Sub 許斐_2()
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim MaxRow As Long ' 最終行
Dim key As String ' 検索キー
Dim c As Long, r As Long
Dim tbl As Variant, x As Variant
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
MaxRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row ' 最終行を求める
ws2.Range("F5:Q41").ClearContents
' 売上明細を連想配列へ読み込む
With ws1
tbl = .Cells(1, 1).Resize(MaxRow, 6).Value
For r = 2 To MaxRow ' 最終行
key = Format(tbl(r, 1), "ge.m") & tbl(r, 4) & tbl(r, 3) ' 店舗CD & 分類CD
dicT(key) = dicT(key) + tbl(r, 6) ' 売上額
Next
End With
' 集計シートへの書き出し
With ws2
MaxRow = Range("D5").End(xlDown).Row ' 最終行を求める
tbl = .Cells(1, 1).Resize(MaxRow, 17).Value
ReDim x(1 To MaxRow, 1 To 12)
For c = 6 To 17 ' 列
For r = 5 To MaxRow ' 行
key = Format(tbl(4, c), "ge.m") & tbl(r, 4) & tbl(r, 5) ' 店舗 & 分類
x(r - 4, c - 5) = IIf(dicT(key) = "", 0, dicT(key))
Next
Next
.Cells(5, 6).Resize(MaxRow - 4, 12).Value = x
End With
End Sub
です。力不足ですみません ＞＜
(許斐）
もう一度書きます。 シート名がどうなっているとき どちらのデータを見ればよいのか教えて下さい。
11-20,12-20,13-20,14-20,15-20 の時 売上明細1 16-20,17-20,18-20,19-20,20-20 の時 売上明細2 ですか？
でしたら、 シート名の前２文字が15以下の時 売上明細1 シート名の前２文字が15より大の時 売上明細2 のデータを使用すれば良いですね。
(HANA)
11-20 の時 売上明細1 16-20 の時 売上明細2 でお願いします。 >シート名の前２文字が15以下の時 売上明細1 数字で比較ではなくシート名とし比較をお願いします。 (シート名変更可能性あり）
（許斐）
それでは提案ですが それぞれのシートのどこかのセルに どちらのデータを見ればよいのか 書いておくことは出来ませんか？
＞(シート名変更可能性あり） と言うことですし 何を元データにして計算されたのか 情報として載っていても良いと思いますが。
(HANA)
そうですね＾＾ 一度データを整理させてください。 HANAさんに言われたとおりに集計シートはまとめる必要がありそうです。 無駄が非常に多いです。 データをしっかりと整理し再度質問させてください。 このままでは回答がころころ変更しそうです。 売上明細 と 11-20 を各一枚にしたい （－－＃） 上司を格闘してきます。 名前もわかりにくいですしね＾＾；；数字では何が入っているのかわからないです。
本当に勝手ですみません。今回もわかりやすい授業を本当にありがとうございます。 また、次回も見かけましたらよろしくお願いします。
(許斐）
ん？ ＞売上明細 と 11-20 を各一枚にしたい 売り上げ明細は、一つの表がデータ数の関係上 （なんだか、何だかよく分かりませんが。。。） 二つに分かれているだけなんですよね？ でしたら、一つにまとめられそうですが
11-20 とかの各シートの方は それぞれ集計する項目が違うんですよね？ つまり、D列に入っている項目が違う。 そしたら、こちらを一つにすると言うのは・・・？
それにしても Worksheet_Change の度に ファイルを開くんですか？ そしたら、アクティブシートが移動して仕舞いますね。
(HANA)
>アクティブシートが移動して仕舞いますね。 そうですね（ToT) 開閉をチェックしてからopenさせたほうがいいのでしょか？
（許斐）上司に怒られるとやる気なくした私であります。
今日はここまで。。。。。また明日にお願いします。
いや、移動しても良いのですが こんなに密接な関係にあるデータを 別ブックにしてあるのが一寸意外でした。
しかも、実行時に使用中や何かのトラブルで 開けないとアウトですから。 別ブックにしてあるのは、何か意味があるんですか？ 別の事にも使おうと思っているとか？
仕事は。。。ぼちぼちやりましょうよ。
(HANA)
> 何も考えずにすごく簡単にな集計マクロ作成しました
今ごろ何の参考にもならないかもしれませんが、元々は、以下を参考にされたのですよね？ http://www.niji.or.jp/home/toru/notes/17.html 参考にした情報があれば、紹介していただければ、シートイメージなどわかりやすかったかもしれません。
(とおりすがり)
>別ブックにしてあるのは、何か意味があるんですか？ 量が多いことと使いやすさです。？
>アクティブシートが移動して仕舞いますね 集計が変になります。なぜでしょ 値クリア作動しないのです。 そのために指定範囲に集計されない状況になりました。 （41行目から集計されました。）
とおりすがり そうなんですが、二回目にそのサイトを見つけられなかったとです。（ドジ子）
(許斐）ブックマークに入れよ～♪ 謝謝
＞量が多いことと使いやすさです。？ 問題は「使いやすさ」と言う点ですが 別ブックに成っている使いやすさは何でしょう？
例えば、 データを頻繁に更新する。 その際、別のシステムでこの様な形で出力されるので そのブックを上書きすれば良いだけにしたい。 とか 別の集計にもこのデータを使用することを考えているので 大本のデータが特定のブックに入っていると不都合が在る。 等。
どうしても分けておいた方が良い理由が在るなら別ですが そうでない場合は分けない方が考え方も簡単に成ると思いますし よく分からない人に勝手にファイル名、場所などを変更されて コードが動かなくなるような心配も少なくなると思います。
その際でも、もしもこのマクロが頻繁に実行されるなら （Changeイベントにしてあることを考えると 頻繁に実行する事を想定して居られると思いますが） データを自ブックに参照し、それを使うことにするのが良いと思います。 自ブックに参照するタイミングをいつにするか 等は 慎重に考える必要が在ると思いますが。
前の時も思ったのですが 無条件で、データは外に置く 事に決めてませんか？ 色々な事情を踏まえてこの様にする事に なさって居られるのでしたら 実際はそうすることがベストなのかもしれませんが。
＞集計が変になります。なぜでしょ 私は、どんなコードを使って居られるのか存じ上げません。
(HANA)
理由は ・データを頻繁に更新する。 ・その際、別のシステムでこの様な形で出力される。 ・別の集計にもこのデータを使用する。 ・大本のデータが特定のブックに入っていると不都合が在る。 です。
>その際でも、もしもこのマクロが頻繁に実行されるなら >（Changeイベントにしてあることを考えると > 頻繁に実行する事を想定して居られると思いますが） >データを自ブックに参照し、それを使うことにするのが良いと思います。 >自ブックに参照するタイミングをいつにするか 等は >慎重に考える必要が在ると思いますが。 >どんなコードを使って居られるのか存じ上げません。
コードは↑の許斐_2を使用しています。 bookが開いている状態は正常に集計されますが、 bookを自動に開かせてから（チェンジイベントで）集計の場合は41行目から集計されます。
' ファイルを開く
strFnm = ThisWorkbook.Path & "\date.xls"
Set wb = GetObject(strFnm)
wb.Windows(1).Visible = True
自動ファイル開く↑を使用した集計表は非常に苦労しました。
（集計シートの範囲をクリアせずに、データ元の値を消されたり 等）
sub 許斐_2を正常に集計させるにはどうしたらいいのでしょか？？
(許斐）
＞データを頻繁に更新する。 ＞別の集計にもこのデータを使用する。 でしたら、この集計で開いて占有しては 問題があると思いますが。
＞コードは↑の許斐_2を使用しています。 えっと、「許斐_2」って私が載せた物と 許斐さんが載せた物と二つありますが？ ＞>１．現在出来ているコードを載せて下さい の下に載せて居られるコードですか？ これを単独に動かしているのですか？ それとも「Private Sub Worksheet_Change(ByVal Target As Range)」から Callして動かしているのですか？
＞・大本のデータが特定のブックに入っていると不都合が在る。 でしたら、外部データの取込等で 自ブックへ取り込むようにしてはどうでしょう。
(HANA)
>'該当ファイルを開くの意味 すみません。↑私のコードの解説あっていますか？ >外部データの取込等で >自ブックへ取り込むようにしてはどうでしょう。 マクロででしょか？ 実際のデーターをでしょか？
Private Sub Worksheet_Change(ByVal Target As Range)」から Callして動かしています。
Private Sub Worksheet_Change(ByVal Target As Range)
Dim wb As Workbook
Dim strFnm As String
Dim f, w As Workbook
If Target.Address(0, 0) <> "F4" Then Exit Sub
'該当ファイルを開くの意味
strFnm = ThisWorkbook.Path & "\date.xls" '調べるファイル名を指定
Set wb = GetObject(strFnm) '指定ファイル名を開く
wb.Windows(1).Visible = True '先頭ウインドウに表示
Call 許斐_3
MsgBox "集計終わりました。"
End Sub
==========================================================
Sub 許斐_3() '←名前を変更しまし。
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim MaxRow As Long ' 最終行
Dim key As String ' 検索キー
Dim c As Long, r As Long
Dim tbl As Variant, x As Variant
Set ws1 = WorkWorkbooks("date.xls").Sheets("売上明細")
Set ws2 = Workbooks("集計.xls").Sheets("11-20")
ws2.Range("F5:Q41").ClearContents
Set dicT = CreateObject("Scripting.Dictionary") ' 連想配列の定義
MaxRow = ws1.Cells(Rows.Count, 1).End(xlUp).Row ' 最終行を求める
' 売上明細を連想配列へ読み込む
With ws1
tbl = .Cells(1, 1).Resize(MaxRow, 6).Value
For r = 2 To MaxRow ' 最終行
key = Format(tbl(r, 1), "ge.m") & tbl(r, 4) & tbl(r, 3)
dicT(key) = dicT(key) + tbl(r, 6) ' 売上額
Next
End With
' 集計シートへの書き出し
With ws2
MaxRow = Range("D5").End(xlDown).Row ' 最終行を求める
tbl = .Cells(1, 1).Resize(MaxRow, 17).Value
ReDim x(1 To MaxRow, 1 To 12)
For c = 6 To 17 ' 列
For r = 5 To MaxRow ' 行
key = Format(tbl(4, c), "ge.m") & tbl(r, 4) & tbl(r, 5)
x(r - 4, c - 5) = IIf(dicT(key) = "", 0, dicT(key))
Next
Next
.Cells(5, 6).Resize(MaxRow - 4, 12).Value = x
End With
End Sub
（許斐）
＞実際のデーターをでしょか？ 実際のデータです。
メニュー→データ(D)→外部データの取り込み(D)→データの取り込み(D) で、外部データを取り込めます。 一度設定しておけば データの更新更新(R) で最新データに更新出来ます。 すると、date.xlsブックを開いたり閉じたりする必要が無くなります。
現在の問題は単純に
＞MaxRow = Range("D5").End(xlDown).Row ' 最終行を求める
~~アクティブシートの状態を見ています。
この部分が問題になっているのではないでしょうか。
それから、今から同じ範囲に新しいｘを書き出すので
＞ws2.Range("F5:Q41").ClearContents
は不要に思います。
＞>'該当ファイルを開くの意味 ＞すみません。↑私のコードの解説あっていますか？ 私はこの様な使い方をしたことが無いので分かりません。
(HANA)
＞MaxRow = Range("D5").End(xlDown).Row ' 最終行を求める
あ！「.」がない。。。
すみません本当にドジ子ですね＞＜
無事に解決できました。本当にありがとうございました。
(許斐）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.