[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『Dictionary について』（m-o-mo）
お世話になります。教えてください。 Dictionaryで勉強中ですが、一向にわからないです。＞＜
条件が 重複しない項目と条件付合計
("dt.xls").Sheets("Sheets2") ←集計もとのデータ2行目からで普通の一覧表
[A] [B] [C] [D] [E] [F]
年月日 地名 項目 人名 金額 人数
H21.1 UY GS GK 159,650 1462
H21.1 DJ GS GK 2,074 19
H21.1 DJ KS GK 63,279 612.01
H21.1 SB GS GK 58,859 539
H21.1 SB KS GG 15,612 151
H21.1 DJ（西） GS GK 15,835 145.01
H21.1 TH GS GK 49,730 455.4
H21.1 TH KS GK 10,753 104
H21.1 UY（大） GS GM 36,472 334
H21.1 UY（大） KS GK 6,307 61
H21.1 UY（鶴） GS GD 32,760 300
H21.1 UY（鶴） KS GK 25,021 242
("集計.xls").Sheets("予算") ←集計表
[A] [B＆C] [D] [E] [F] [G]
[41]月 地名 伝表発行 GS KS 金額（円）
[42]H21.4.1 EK （m-o-mo） 1,074.00 122,919
[43] DJ （m-o-mo） 18.00 421.00 45,589
[44] SB （m-o-mo） 498.00 125.00 69,920
[45] DJ(西) （m-o-mo） 73.00 18.00 10,215
[46] TH （m-o-mo） 436.00 86.00 58,790
[47] NH(大) （m-o-mo） 452.00 112.00 63,311
[48] NH(鶴) （m-o-mo） 281.00 169.00 49,633
[49]月計 420,377
[50]月 地名 伝表発行 GS KS 金額（円)
[51]H21.5.1 EK （m-o-mo） 1,076.00 128,797
[52] DJ （m-o-mo） 420.00 44,307
[53] SB(西) （m-o-mo） 538.00 73.00 72,099
[54] DJ(西) （m-o-mo） 86.00 10,294
[55] TH （m-o-mo） 494.00 107.00 70,419
[56] NH(大) （m-o-mo） 373.00 78.00 52,876
[57] NH(鶴) （m-o-mo） 213.00 245.00 51,342
[58]月計 430,134
よろしくお願いします。
なにがなんだか.... (seiya)
こんにちは。かみちゃん です。
> 一向に分からないことがあります。
1. マクロ実行時のシートレイアウトおよび値（サンプルで可）がどうなっていて、 2. どのようなコードのマクロを実行したら、 3. どのような結果のシートレイアウトになってしまって、 4. どのような結果を期待しているのか を整理してみてはいかがでしょうか？
計1、計2。金額（円）のそれぞれの列は、E列、F列、G列なのかもよくわかりませんので、 列番号も明確にしていただきたいです。
(かみちゃん) 2009/08/13 19:57
すみません＾＾；；サンプルなしで回答が得れば〜と思いました、、、、、、
＞1. マクロ実行時のシートレイアウトおよび値（サンプルで可）がどうなっていて、 > 計1、計2。金額（円）のそれぞれの列は、E列、F列、G列なのかもよくわかりませんので、 > 列番号も明確にしていただきたいです。
↑の内容を修正しました。(> <;;;;;
＞2. どのようなコードのマクロを実行したら、 ＞3. どのような結果のシートレイアウトになってしまって、
まねて作りましたが、エラーばかり＆内容消されたりで思い通りにいきません。
Sub 項目合計合計合計() Dim WS1 As Worksheet Dim WS2 As Worksheet Dim myVal As Variant Dim myKey As String Dim mydic As Object Dim mydic2 As Object Dim i As Long
Const GK As String = "GK"
Set WS1 = Workbooks("dt.xls").Sheets("Sheets2")
Set WS2 = Workbooks("集計.xls").Sheets("予算")
myVal = WS1.Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
Set mydic = CreateObject("Scripting.Dictionary")
Set mydic2 = CreateObject("Scripting.Dictionary")
'mydicへ格納
For i = 2 To UBound(vntData, 1)
myKey = myVal(i, 1) & "_" & myVal(i, 2) & "," & myVal(i, 4)
'金額合計
If mydic.exists(myKey) Then
mydic(myKey) = dic(myKey) + myVal(i, 6)
Else
mydic.Add myKey, myVal(i, 6)
End If
'人数合計
If mydic2.exists(myKey) Then
mydic2(myKey) = mydic2(myKey) + myVal(i, 5)
Else
mydic2.Add myKey, myVal(i, 5)
End If
Next
'myKeyを書き出す
With WS2.Range("A42:G154")
myVal = .Value
For i = 1 To UBound(myVal, 1)
If myVal(i, 1) = "" Then
myVal(i, 1) = myVal(i - 10, 1)
End If
myVal(i + 2, 2) = mydic(myVal(i, 2))
myVala(i + 2, 5) = mydic(myVal(i, 2)) & Cell(41, 5)
myVal(i + 2, 6) = mydic(myVal(i, 2)) & Cell(41, 6)
myVal(i + 2, 7) = mydic2(myVal(i, 2)) & Cell(41, 6) & "," & GK
Next
Range("B42").Resize(mydic.Count).Value = WorksheetFunction.Index(myVal, 0, 2)
Range("E42").Resize(mydic.Count).Value = WorksheetFunction.Index(myVal, 0, 5)
Range("F42").Resize(mydic.Count).Value = WorksheetFunction.Index(myVal, 0, 6)
Range("G42").Resize(mydic2.Count).Value = WorksheetFunction.Index(myVal, 0, 7)
End With
Set dic = Nothing MsgBox "集計が完了しました" End Sub
＞4. どのような結果を期待しているのか
("集計.xls").Sheets("予算") ←集計表
[A] [B＆C] [D] [E] [F] [G]
[41]月 地名 伝表発行 GS KS 金額 （円）
[42]H21.4.1
1.A列の年月日の地名を抜け出す（毎月決まって７項目しかありません。内容は微妙に違います。）
2.各地名の[E]と[F]の人数を合計
（[E][F]のGS＆KSはSheets2の[C]列の項目名。合計値は[F]列の人数）
3.[G]列は金額の合計
（Sheets2のGKさんのデータのみ。合計値は[E]金額です。）
自分のコードはまったく検討はずれでしょか？ なぜ上手く結果を得られないのでしょか？ 何かが足りない？ 一週間ほどいろいろ替えてみて検索したんですが、まったく正常に動く気配がないです。
1) ("dt.xls").Sheets("Sheets2")のA列の値はシリアル値（日付）ですか？
2) ("集計.xls").Sheets("予算")は定型でそこに埋め込むのですか？
もし行が足りなくなったらどうするのでしょう？
2) ("集計.xls").Sheets("予算")のB:Cは列全体が結合されてるのですか？
できれば、サンプルデータに対応した結果がっ見たいのですが？ (seiya)
返事ありがとうございます。
>1) ("dt.xls").Sheets("Sheets2")のA列の値はシリアル値（日付）ですか？
はいそうです。
>2) ("集計.xls").Sheets("予算")は定型でそこに埋め込むのですか？
はいそうです。
> もし行が足りなくなったらどうするのでしょう？
EK
DJ
SB(西)
DJ(西)
TH
NH(大)
NH(鶴)
ローマ字は支店名で7支店しかありませんのでは必ず７項目です。（）の内容が変わります。
>2) ("集計.xls").Sheets("予算")のB:Cは列全体が結合されてるのですか？
地名は B:C 2列で使用していますが、結合は解除しています。
>できれば、サンプルデータに対応した結果がっ見たいのですが？
↑修正しました。
説明が足りずにすみません＞＜ なおこれ以降の回答は月曜日にさせてください。
> 1.A列の年月日の地名を抜け出す（毎月決まって７項目しかありません。内容は微妙に違います。） > 2.各地名の[E]と[F]の人数を合計 > （[E][F]のGS＆KSはSheets2の[C]列の項目名。合計値は[F]列の人数） > 3.[G]列は金額の合計 > （Sheets2のGKさんのデータのみ。合計値は[E]金額です。）
内容からすると、さほど複雑な処理とは思えませんが、ご提示のデータと導き出された結果の 関連性がわかりません。 おそらく、元データと結果は違うデータを使用しているのかと思いますがそこまでは読めません。 (seiya)
> 'mydicへ格納 > For i = 2 To UBound(vntData, 1) ここで vntDataは配列の名前です。 ですが、宣言されておらず、サイズを指定されておらず、データを格納されていません。
> myVal = WS1.Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
> myKey = myVal(i, 1) & "_" & myVal(i, 2) & "," & myVal(i, 4)
myValにはA列のデータしか入っていません。したがってmyVal(i, 2)は意味をなしません。
以下のコードは見ておりませんが、つねに配列の内容を意識してコードを書かれるほうがよいです。
こんにちは。かみちゃん です。
> これ以降の回答は月曜日にさせてください。
ということでこちらで、いろいろと推測をさせていただき、考えてみました。
マクロ実行前に以下のようなシートがあるものとします。
("dt.xls").Sheets("Sheets2")
[A] [B] [C] [D] [E] [F]
[ 1] 年月日 地名 項目 人名 金額 人数
[ 2] H21.1 UY GS GK 159,650 1462
[ 3] H21.1 DJ GS GK 2,074 19
[ 4] H21.1 DJ KS GK 63,279 612.01
[ 5] H21.1 SB GS GK 58,859 539
[ 6] H21.1 SB KS GG 15,612 151
[ 7] H21.1 DJ（西） GS GK 15,835 145.01
[ 8] H21.1 TH GS GK 49,730 455.4
[ 9] H21.1 TH KS GK 10,753 104
[10] H21.1 UY（大） GS GM 36,472 334
[11] H21.1 UY（大） KS GK 6,307 61
[12] H21.1 UY（鶴） GS GD 32,760 300
[13] H21.1 UY（鶴） KS GK 25,021 242
("集計.xls").Sheets("予算")
[A] [B] [C] [D] [E] [F] [G]
[41] 月 地名 地名 伝表発行 GS KS 金額（円）
[42] H21.1 DJ
[43] DJ（西）
[44] SB
[45] TH
[46] UY
[47] UY（大）
[48] UY（鶴）
[49] 月計
[50] 月 地名 地名 伝表発行 GS KS 金額（円）
[51] H21.2 DJ
[52] DJ（西）
[53] SB
[54] TH
[55] UY
[56] UY（大）
[57] UY（鶴）
[58] 月計
マクロを実行すると、以下の結果が得たいものとします。
("集計.xls").Sheets("予算")
[A] [B] [C] [D] [E] [F] [G]
[41] 月 地名 地名 伝表発行 GS KS 金額（円）
[42] H21.1 DJ 19 612.01 65353
[43] DJ（西） 145.01 15835
[44] SB 539 58859
[45] TH 455.4 104 60483
[46] UY 0
[47] UY（大） 61 6307
[48] UY（鶴） 242 25021
[49] 月計 231858
[50] 月 地名 地名 伝表発行 GS KS 金額（円）
[51] H21.2 DJ 0
[52] DJ（西） 0
[53] SB 0
[54] TH 0
[55] UY 0
[56] UY（大） 0
[57] UY（鶴） 0
[58] 月計 0
この場合、提示されたマクロをできるだけ活かす形で修正すると、以下のような感じでできます。
★の行は追加した行 ☆の行は削除する行
Sub 項目合計合計合計2() Dim WS1 As Worksheet Dim WS2 As Worksheet Dim myVal As Variant Dim myKey As String Dim mydic As Object Dim mydic2 As Object Dim i As Long Dim j As Long '★ Dim lngColumnMax As Long '★ Dim dblSum As Double '★
Const GK As String = "GK"
Set WS1 = Workbooks("dt.xls").Sheets("Sheets2")
Set WS2 = Workbooks("集計.xls").Sheets("予算")
' myVal = WS1.Range("A2", Range("A" & Rows.Count).End(xlUp)).Value '☆
myVal = WS1.Range("A2", WS1.Range("A" & Rows.Count).End(xlUp)).Resize(, 6).Value '★
Set mydic = CreateObject("Scripting.Dictionary")
Set mydic2 = CreateObject("Scripting.Dictionary")
'mydicへ格納
' For i = 2 To UBound(vntData, 1) '☆
For i = 2 To UBound(myVal, 1) '★
' myKey = myVal(i, 1) & "_" & myVal(i, 2) & "," & myVal(i, 4) '☆
myKey = myVal(i, 1) & "_" & myVal(i, 2) & "," & myVal(i, 3) & "," & myVal(i, 4) '★
'金額合計
If mydic.Exists(myKey) Then
' mydic(myKey) = dic(myKey) + myVal(i, 6)
mydic(myKey) = mydic(myKey) + myVal(i, 5)
Else
' mydic.Add myKey, myVal(i, 6)
mydic.Add myKey, myVal(i, 5)
End If
'人数合計
If mydic2.Exists(myKey) Then
' mydic2(myKey) = mydic2(myKey) + myVal(i, 5)
mydic2(myKey) = mydic2(myKey) + myVal(i, 6)
Else
' mydic2.Add myKey, myVal(i, 5)
mydic2.Add myKey, myVal(i, 6)
End If
Next
'myKeyを書き出す
' With WS2.Range("A42:G154")
With WS2.Range("A41:G58")
On Error Resume Next '★
.SpecialCells(xlCellTypeConstants, 1).ClearContents '★
On Error GoTo 0 '★
lngColumnMax = .Columns.Count '★
' myVal = .Value '☆
myVal = .Resize(, lngColumnMax + 1).Value
For i = 1 To UBound(myVal, 1)
' If myVal(i, 1) = "" Then '☆
' myVal(i, 1) = myVal(i - 10, 1) '☆
' End If '☆
' myVal(i + 2, 2) = mydic(myVal(i, 2)) '☆
' myVala(i + 2, 5) = mydic(myVal(i, 2)) & Cell(41, 5) '☆
' myVal(i + 2, 6) = mydic(myVal(i, 2)) & Cell(41, 6) '☆
' myVal(i + 2, 7) = mydic2(myVal(i, 2)) & Cell(41, 6) & "," & GK '☆
If Not myVal(i, 1) Like "月*" Then '★
If myVal(i, 1) = "" Then '★
myVal(i, lngColumnMax + 1) = myVal(i - 1, lngColumnMax + 1) '★
Else '★
myVal(i, lngColumnMax + 1) = myVal(i, 1) '★
End If '★
For j = 5 To lngColumnMax - 1 '★
myKey = myVal(i, lngColumnMax + 1) & "_" & myVal(i, 2) & "," & myVal(1, j) & "," & GK '★
myVal(i, j) = mydic2(myKey) '★
myVal(i, lngColumnMax) = myVal(i, lngColumnMax) + mydic(myKey) '★
Next '★
dblSum = dblSum + myVal(i, lngColumnMax) '★
Else '★
If myVal(i, 1) = "月計" Then '★
myVal(i, lngColumnMax) = dblSum '★
dblSum = 0 '★
End If '★
End If '★
Next
.Value = myVal '★
' Range("B42").Resize(mydic.Count).Value = WorksheetFunction.Index(myVal, 0, 2) '☆
' Range("E42").Resize(mydic.Count).Value = WorksheetFunction.Index(myVal, 0, 5) '☆
' Range("F42").Resize(mydic.Count).Value = WorksheetFunction.Index(myVal, 0, 6) '☆
' Range("G42").Resize(mydic2.Count).Value = WorksheetFunction.Index(myVal, 0, 7) '☆
End With
' Set dic = Nothing '☆ Set mydic = Nothing '★ Set mydic2 = Nothing '★ MsgBox "集計が完了しました" End Sub
また、私なら、以下のようにします。
Sub Sample() Dim WS1 As Worksheet Dim WS2 As Worksheet Dim myVal As Variant Dim myKey As String Dim mydic As Object Dim i As Long Dim j As Long Dim lngColumnMax As Long Dim dblSum As Double
Const GK As String = "GK"
Set WS1 = Workbooks("dt.xls").Sheets("Sheets2")
Set WS2 = Workbooks("集計.xls").Sheets("予算")
myVal = WS1.Range("A2", WS1.Range("A" & Rows.Count).End(xlUp)).Resize(, 6).Value
Set mydic = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(myVal, 1)
myKey = myVal(i, 1) & "," & myVal(i, 2) & "," & myVal(i, 3) & "," & myVal(i, 4)
If Not mydic.Exists(myKey) Then
mydic.Add myKey, Array(myVal(i, 5), myVal(i, 6))
Else
mydic(myKey)(0) = mydic(myKey)(0) + myVal(i, 5)
mydic(myKey)(1) = mydic(myKey)(1) + myVal(i, 6)
End If
Next
With WS2.Range("A41:G58")
'既存集計済みデータのクリア
On Error Resume Next
.SpecialCells(xlCellTypeConstants, 1).ClearContents
On Error GoTo 0
'データ集計
lngColumnMax = .Columns.Count
myVal = .Resize(, lngColumnMax + 1).Value
For i = 1 To UBound(myVal, 1)
If Not myVal(i, 1) Like "月*" Then
If myVal(i, 1) = "" Then
myVal(i, lngColumnMax + 1) = myVal(i - 1, lngColumnMax + 1)
Else
myVal(i, lngColumnMax + 1) = myVal(i, 1)
End If
'金額列の初期化
myVal(i, lngColumnMax) = 0
For j = 5 To lngColumnMax - 1
myKey = myVal(i, lngColumnMax + 1) & "," & myVal(i, 2) & "," & myVal(1, j) & "," & GK
If mydic.Exists(myKey) Then
myVal(i, j) = mydic(myKey)(1)
myVal(i, lngColumnMax) = myVal(i, lngColumnMax) + mydic(myKey)(0)
End If
Next
'月計の集計
dblSum = dblSum + myVal(i, lngColumnMax)
Else
'月計の格納
If myVal(i, 1) = "月計" Then
myVal(i, lngColumnMax) = dblSum
dblSum = 0
End If
End If
Next
'集計結果の出力
.Value = myVal
End With
Set mydic = Nothing MsgBox "集計が完了しました" End Sub
なお、これらで、うまく集計できない場合は、
上記のように、マクロ実行前のシートの状態と、サンプルデータ、
^^^^^^^^^^^^^^
サンプルデータを使った、マクロ実行後の期待している結果
^^^^^^^^^^^^^^^^^^^^^^
を示して再度、初めから説明しなおししてください。
（今までの質問内容は、サンプルデータと説明が合っていないところが多々あります。）
その際、過去の発言内容を編集・修正するのではなく、コメントとして、返信するようにしてください。 また、シートレイアウトやサンプルデータは、Excelシートのセル範囲をコピーして、投稿欄にそのまま 貼り付けていただくといいと思います。 （ずれて見づらくてもいいです。投稿結果をコピーして、Excelシートに貼り付けるときちんとセル位置が反映されると思います）
なお、こちらでは、上記のデータに基づいて、サンプルファイルを作成し、動作検証しています。
(かみちゃん) 2009/08/16 14:27
かみちゃん さん
ありがとうございます。
＞ということでこちらで、いろいろと推測をさせていただき、考えてみました。 私の書いたヘナチョココードをスリムにしていただいてありがとうございます。 しかも、合計までついていて感激です（＞▽＜） おかげさまで自分の失敗が見てきた気がします。(−ｗ−)
自分の目的はA42が2008/4/1の場合 「担当別」B列のダブらない項目を「予算」のB42：B48列（指定した範囲内）に書き出 す。 A52が2008/5/1の場合 「担当別」B列のダブらない項目を「予算」のB52:B52列（指定した範囲内）に書き出す。
なのに私のコードはA列のダブらない項目を書き出すみないな？？
> 上記のように、マクロ実行前のシートの状態と、サンプルデータ、 >サンプルデータを使った、マクロ実行後の期待している結果
("dt.xls").Sheets("担当別") そのままA1〜です。
☆人名欄は約15ほどいますしかし全部乗せると大変にながいので。2008年度「GK」さんのデータのみにしました。 年月日 支店名 項目 人名 金額 人数 H20.4 EK GS GK 136,253 1055 H20.4 DJ GS GK 27,767 215 H20.4 DJ KS GK 58,363 504 H20.4 SB GS GK 63,541 492 H20.4 SB KS GK 13,548 117 H20.4 DJ(西) GS GK 10,461 81 H20.4 DJ(西) KS GK 2,316 20 H20.4 TH GS GK 52,564 407 H20.4 TH KS GK 12,853 111 H20.4 NH(大根) GS GK 47,786 370 H20.4 NH(大根) KS GK 7,758 67 H20.4 NH(鶴巻) GS GK 48,818 378 H20.4 NH(鶴巻) KS GK 22,234 192 H20.6 EK GS GK 175,119 1076 H20.5 DJ GS GK 24,900 153 H20.5 DJ KS GK 51,713 369 H20.5 SB GS GK 87,396 537 H20.5 SB KS GK 21,442 153 H20.5 DJ（西） GS GK 24,738 152 H20.5 DJ（西） KS GK 2,943 21 H20.5 TH GS GK 86,648 532.4 H20.5 TH KS GK 12,472 89 H20.5 NH（大根） GS GK 69,006 424 H20.5 NH（大根） KS GK 8,689 62 H20.5 NH（鶴巻） GS GK 45,869 281.84 H20.5 NH（鶴牧） KS GK 8,689 62 H20.6 EK GS GK 173,401 983 H20.6 DJ GS GK 42,336 240 H20.6 DJ KS GK 67,512 436 H20.6 SB GS GK 86,789 492 H20.6 SB KS GK 15,329 99 H20.6 DJ（西） GS GK 11,466 65 H20.6 DJ（西） KS GK 4,490 29 H20.6 TH GS GK 79,309 449.6 H20.6 TH KS GK 12,852 83 H20.6 NH（大根） GS GK 54,507 309 H20.6 NH（大根） KS GK 11,613 75 H20.6 NH（鶴巻） GS GK 55,036 312 H20.6 NH（鶴巻） KS GK 27,717 179 H20.7 EK GS GK 204,943 1109 H20.7 DJ GS GK 31,970 173 H20.7 DJ KS GK 72,454 441 H20.7 SB GS GK 101,085 547 H20.7 SB KS GK 18,894 115 H20.7 DJ（西） GS GK 33,264 180 H20.7 DJ（西） KS GK 3,121 19 H20.7 TH GS GK 105,150 569 H20.7 TH KS GK 29,310 178.4 H20.7 NH(大根） GS GK 58,396 316 H20.7 NH(大根） KS GK 14,457 88 H20.7 NH(鶴巻） GS GK 67,452 365 H20.7 NH(鶴巻） KS GK 20,536 125 H20.8 EK GS GK 188,513 1003 H20.8 DJ GS GK 52,813 281 H20.8 DJ KS GK 116,262 690 H20.8 SB GS GK 128,557 684 H20.8 SB KS GK 23,084 137 H20.8 DJ（西） GS GK 21,238 113 H20.8 TH GS GK 96,343 512.6 H20.8 TH KS GK 21,061 125 H20.8 UY（大根） GS GK 61,647 328 H20.8 UY（大根） KS GK 14,996 89 H20.8 UY（鶴巻） GS GK 54,693 291 H20.8 UY（鶴巻） KS GK 44,988 267 H20.9 UY GS GK 203,447 1120 H20.9 DJ GS GK 7,810 43 H20.9 DJ KS GK 72,676 451 H20.9 SB GS GK 97,546 537 H20.9 SB KS GK 24,977 155 H20.9 DJ（西） GS GK 22,342 123 H20.9 TH GS GK 100,997 556 H20.9 TH KS GK 25,622 159 H20.9 UY（大根） GS GK 66,302 365 H20.9 UY（大根） KS GK 12,891 80 H20.9 UY（鶴巻） GS GK 54,313 299 H20.9 UY（鶴巻） KS GK 25,944 161 H20.10 UY GS GK 225,212 1324 H20.10 UY KS GK 3,314 22 H20.10 DJ KS GK 52,876 351 H20.10 SB GS GK 98,487 579 H20.10 SB KS GK 26,362 175 H20.10 DJ（西） GS GK 20,922 123 H20.10 TH GS GK 79,266 466 H20.10 TH KS GK 22,596 150 H20.10 NHｓ（大根） GS GK 59,705 351 H20.10 NHｓ（大根） KS GK 10,394 69 H20.10 NH（鶴巻） GS GK 49,329 290 H20.10 NH（鶴巻） KS GK 24,253 161 H20.11 UY GS GK 170,606 1186 H20.11 DJ（西） KS GK 74,057 549 H20.11 SB GS GK 80,412 559 H20.11 SB KS GK 14,703 109 H20.11 DJ GS GK 7,192 50 H20.11 DJ KS GK 2,293 17 H20.11 TH GS GK 72,788 506 H20.11 TH KS GK 18,885 140 H20.11 UY（大根） GS GK 58,115 404 H20.11 UY（大根） KS GK 6,205 46 H20.11 UY（鶴巻） GS GK 37,976 264 H20.11 UY（鶴巻） KS GK 22,527 167 H20.12 UY GS GK 175,318 1415 H20.12 DJ GS GK 2,230 18 H20.12 DJ KS GK 73,809 625 H20.12 SB GS GK 83,385 673 H20.12 SB KS GK 24,563 208 H20.12 DJ（西） GS GK 10,160 82 H20.12 TH GS GK 68,145 550 H20.12 TH KS GK 23,737 201 H20.12 UY（大根） GS GK 52,905 427 H20.12 UY（大根） KS GK 9,684 82 H20.12 UY（鶴巻） GS GK 52,781 426 H20.12 UY（鶴巻） KS GK 23,265 197 H21.1 UY GS GK 159,650 1462 H21.1 DJ GS GK 2,074 19 H21.1 DJ KS GK 63,279 612.01 H21.1 SB GS GK 58,859 539 H21.1 SB KS GK 15,612 151 H21.1 DJ（西） GS GK 15,835 145.01 H21.1 TH GS GK 49,730 455.4 H21.1 TH KS GK 10,753 104 H21.1 UY（大根） GS GK 36,472 334 H21.1 UY（大根） KS GK 6,307 61 H21.1 UY（鶴巻） GS GK 32,760 300 H21.1 UY（鶴巻） KS GK 25,021 242 H21.2 UY GS GK 123,360 1098 H21.2 DJ KS GK 49,629 480 H21.2 SB GS GK 60,467 538.21 H21.2 SB KS GK 15,200 147.01 H21.2 DJ（西） GS GK 8,539 76 H21.2 TH GS GK 52,130 464 H21.2 TH KS GK 19,955 193 H21.2 UY（大根） GS GK 44,378 395 H21.2 UY（大根） KS GK 8,375 81 H21.2 UY（鶴巻） GS GK 36,401 324 H21.2 UY（鶴巻） KS GK 23,574 228 H21.3 UY GS GK 143,863 1257 H21.3 DJ KS GK 53,972 522 H21.3 SB GS GK 54,307 474.51 H21.3 SB KS GK 13,702 132.53 H21.3 DJ（西） GS GK 10,529 92 H21.3 TH GS GK 51,537 450.3 H21.3 TH KS GK 14,268 138 H21.3 UY（大根） GS GK 33,877 296 H21.3 UY（大根） KS GK 5,583 54 H21.3 UY（鶴巻） GS GK 36,967 323 H21.3 UY（鶴巻） KS GK 10,029 97
("集計.xls").Sheets("予算")
A列の日付は
A41(2008/4/1)=DATE(J1,4,1)
A50(2008/5/1)=DATE(YEAR(B42),MONTH(B42)+1,1)
A60(2008/6/1)=DATE(YEAR(B51),MONTH(B51)+1,1)
以降の月も同様です。
[E][F]の項目名は書式設定 ＝＠"人"
[G]は書式設定＝＠"円"
なお、[G][H]は結合されています。
[A] [B] [C] [D] [E] [F] [G] [H] [39] 月別内訳 [40] 月 支店 伝表発行 GS （人） KS （人 ） 金額 （円） [41] 2008/4/1 （m-o-mo） 0 [42] （m-o-mo） 0 [43] （m-o-mo） 0 [44] （m-o-mo） 0 [45] （m-o-mo） 0 [46] （m-o-mo） 0 [47] （m-o-mo） 0 [48] 月計 [49] 月 支店 伝表発行 GS （人） KS （人） 金額 （円） [50] 2008/5/1 （m-o-mo） 0 [51] （m-o-mo） 0 [52] （m-o-mo） 0 [53] （m-o-mo） 0 [54] （m-o-mo） 0 [55] （m-o-mo） 0 [56] （m-o-mo） 0 [57] 月計 [58] 月 支店 伝表発行 GS （人） KS （人） 金額 （円） [59] 2008/6/1 （m-o-mo） [60] （m-o-mo） [61] （m-o-mo） [62] （m-o-mo） [63] （m-o-mo） [64] （m-o-mo） [65] （m-o-mo） [66] 月計 0 [67] 月 支店 伝表発行 GS （人） KS （人） 金額 （円） [68] 2008/7/1 （m-o-mo） [69] （m-o-mo） [70] （m-o-mo） [71] （m-o-mo） [72] （m-o-mo） [73] （m-o-mo） [74] （m-o-mo） [75] 月計 0 [76] 月別内訳 [77] 月 支店 伝表発行 GS （人） KS （人） 金額 （円） [78] 2008/8/1 （m-o-mo） [79] （m-o-mo） [80] （m-o-mo） [81] （m-o-mo） [82] （m-o-mo） [83] （m-o-mo） [84] （m-o-mo） [85] 月計 0 [86] 月 支店 伝表発行 GS （人） KS （人） 金額 （円） [87] 2008/9/1 （m-o-mo） [88] （m-o-mo） [89] （m-o-mo） [90] （m-o-mo） [91] （m-o-mo） [92] （m-o-mo） [93] （m-o-mo） [94] 月計 0 [95] 月 支店 伝表発行 GS （人） KS （人） 金額 （円） [96] 2008/10/1 （m-o-mo） [97] （m-o-mo） [98] （m-o-mo） [99] （m-o-mo） [100] （m-o-mo） [101] （m-o-mo） [102] （m-o-mo） [103] 月計 0 [104] 月 支店 伝表発行 GS （人） KS （人） 金額 （円） [105] 2008/11/1 （m-o-mo） [106] （m-o-mo） [107] （m-o-mo） [108] （m-o-mo） [109] （m-o-mo） [110] （m-o-mo） [111] （m-o-mo） [112] 月計 0 [113] 月別内訳 [114] 月 支店 伝表発行 GS （人） KS （人） 金額 （円） [115] 2008/12/1 （m-o-mo） [116] （m-o-mo） [117] （m-o-mo） [118] （m-o-mo） [119] （m-o-mo） [120] （m-o-mo） [121] （m-o-mo） [122] 月計 0 [123] 月 支店 伝表発行 GS （人） KS （人） 金額 （円） [124] 2009/1/1 （m-o-mo） [125] （m-o-mo） [126] （m-o-mo） [127] （m-o-mo） [128] （m-o-mo） [129] （m-o-mo） [130] （m-o-mo） [131] 月計 0 [132] 月 支店 伝表発行 GS （人） KS （人） 金額 （円） [133] 2009/2/1 （m-o-mo） [134] （m-o-mo） [135] （m-o-mo） [136] （m-o-mo） [137] （m-o-mo） [138] （m-o-mo） [139] （m-o-mo） [140] 月計 0 [141] 月 支店 伝表発行 GS （人） KS （人） 金額 （円） [142] 2009/3/1 （m-o-mo） [143] （m-o-mo） [144] （m-o-mo） [145] （m-o-mo） [146] （m-o-mo） [147] （m-o-mo） [148] （m-o-mo） [149] 月計 0
「マクロ実行後の期待している結果」
月別内訳 月 支店 伝表発行 GS （人） KS （人） 金額（円） 2008/4/1 EK （m-o-mo） 1,055.00 136,253 DJ （m-o-mo） 215.00 504.00 86,130 SB （m-o-mo） 492.00 117.00 77,089 DJ（西） （m-o-mo） 81.00 20.00 12,777 TH （m-o-mo） 407.00 111.00 65,417 NH（大根） （m-o-mo） 370.00 67.00 55,544 NH（鶴巻） （m-o-mo） 378.00 192.00 71,052 月計 504,262 月 支店 伝表発行 GS （人） KS （人） 金額（円） 2008/5/1 EK （m-o-mo） 1,076.00 175,119 DJ （m-o-mo） 153.00 369.00 76,613 SB （m-o-mo） 537.00 153.00 108,838 DJ（西） （m-o-mo） 152.00 21.00 27,681 TH （m-o-mo） 532.40 89.00 99,120 NH（大根） （m-o-mo） 424.00 62.00 77,695 NH（鶴巻） （m-o-mo） 281.84 62.00 54,558 月計 619,624 月 支店 伝表発行 GS （人） KS （人） 金額（円） 2008/6/1 EK （m-o-mo） 983.00 173,401 DJ （m-o-mo） 240.00 436.00 109,848 SB （m-o-mo） 492.00 99.00 102,118 DJ（西） （m-o-mo） 65.00 29.00 15,956 TH （m-o-mo） 449.60 83.00 92,161 NH（大根） （m-o-mo） 309.00 75.00 66,120 NH（鶴巻） （m-o-mo） 312.00 179.00 82,753 月計 642,357 月 支店 伝表発行 GS （人） KS （人） 金額（円） 2008/7/1 EK （m-o-mo） 1,109.00 204,943 DJ （m-o-mo） 173.00 441.00 104,424 SB （m-o-mo） 547.00 115.00 119,979 DJ（西） （m-o-mo） 180.00 19.00 36,385 TH （m-o-mo） 569.00 178.40 134,460 NH（大根） （m-o-mo） 316.00 88.00 72,853 NH（鶴巻） （m-o-mo） 365.00 125.00 87,988 月計 761,032 月別内訳 月 支店 伝表発行 GS （人） KS （人） 金額（円） 2008/8/1 EK （m-o-mo） 1,003.00 188,513 DJ （m-o-mo） 281.00 690.00 169,075 SB （m-o-mo） 684.00 137.00 151,641 DJ（西） （m-o-mo） 113.00 21,238 TH （m-o-mo） 512.60 125.00 117,404 UY（大根） （m-o-mo） 328.00 89.00 76,643 UY（鶴巻） （m-o-mo） 291.00 267.00 99,681 月計 824,195 月 支店 伝表発行 GS （人） KS （人） 金額（円） 2008/9/1 UY （m-o-mo） 1,120.00 203,447 DJ （m-o-mo） 43.00 451.00 80,486 SB （m-o-mo） 537.00 155.00 122,523 DJ（西） （m-o-mo） 123.00 22,342 TH （m-o-mo） 556.00 159.00 126,619 UY（大根） （m-o-mo） 365.00 80.00 79,193 UY（鶴巻） （m-o-mo） 299.00 161.00 80,257 月計 714,867 月 支店 伝表発行 GS （人） KS （人） 金額（円） 2008/10/1 UY （m-o-mo） 1,324.00 22.00 228,526 DJ （m-o-mo） 351.00 52,876 SB （m-o-mo） 579.00 175.00 124,849 DJ（西） （m-o-mo） 123.00 20,922 TH （m-o-mo） 466.00 150.00 101,862 NH（大根） （m-o-mo） 351.00 69.00 70,099 NH（鶴巻） （m-o-mo） 290.00 161.00 73,582 月計 672,716 月 支店 伝表発行 GS （人） KS （人） 金額（円） 2008/11/1 UY （m-o-mo） 1,186.00 170,606 DJ （m-o-mo） 549.00 74,057 SB （m-o-mo） 559.00 109.00 95,115 DJ（西） （m-o-mo） 50.00 17.00 9,485 TH （m-o-mo） 506.00 140.00 91,673 UY（大根） （m-o-mo） 404.00 46.00 64,320 UY（鶴巻） （m-o-mo） 264.00 167.00 60,503 月計 565,759 月別内訳 月 支店 伝表発行 GS （人） KS （人） 金額（円） 2008/12/1 UY （m-o-mo） 1,415.00 175,318 DJ （m-o-mo） 18.00 625.00 76,039 SB （m-o-mo） 673.00 208.00 107,948 DJ（西） （m-o-mo） 82.00 10,160 TH （m-o-mo） 550.00 201.00 91,882 UY（大根） （m-o-mo） 427.00 82.00 62,589 UY（鶴巻） （m-o-mo） 426.00 197.00 76,046 月計 599,982 月 支店 伝表発行 GS （人） KS （人） 金額（円） 2009/1/1 UY （m-o-mo） 1,462.00 159,650 DJ （m-o-mo） 19.00 612.01 65,353 SB （m-o-mo） 539.00 151.00 74,471 DJ（西） （m-o-mo） 145.01 15,835 TH （m-o-mo） 455.40 104.00 60,483 UY（大根） （m-o-mo） 334.00 61.00 42,779 UY（鶴巻） （m-o-mo） 300.00 242.00 57,781 月計 476,352 月 支店 伝表発行 GS （人） KS （人） 金額（円） 2009/2/1 UY （m-o-mo） 1,098.00 123,360 DJ （m-o-mo） 480.00 49,629 SB （m-o-mo） 538.21 147.01 75,667 DJ（西） （m-o-mo） 76.00 8,539 TH （m-o-mo） 464.00 193.00 72,085 UY（大根） （m-o-mo） 395.00 81.00 52,753 UY（鶴巻） （m-o-mo） 324.00 228.00 59,975 月計 442,008 月 支店 伝表発行 GS （人） KS （人） 金額（円） 2009/3/1 UY （m-o-mo） 1,257.00 143,863 DJ （m-o-mo） 522.00 53,972 SB （m-o-mo） 474.51 132.53 68,009 DJ（西） （m-o-mo） 92.00 10,529 TH （m-o-mo） 450.30 138.00 65,805 UY（大根） （m-o-mo） 296.00 54.00 39,460 UY（鶴巻） （m-o-mo） 323.00 97.00 46,996 月計 428,634
なが〜くなってすみません。
よろしくお願いします。
こんにちは。かみちゃん です。
> なが〜くなってすみません。
これから検証しますが、今何にお困りなのでしょうか？
> 示させたい結果
が崩れていて、見づらいので、再度、サンプルデータに基づいた「マクロ実行後の期待している結果」 を示していただけませんか？
その際のお願いとして、
>> シートレイアウトやサンプルデータは、Excelシートのセル範囲をコピーして、投稿欄にそのまま >> 貼り付けていただくといいと思います。 >> （ずれて見づらくてもいいです。投稿結果をコピーして、Excelシートに貼り付けるときちんとセル位置が反映されると思います）
でお願いできないでしょうか？ 投稿後、ご自身で投稿内容をコピーして、新規のExcelシートに貼り付けてみていただけると、どうなるかがわかると思います。
(かみちゃん) 2009/08/17 12:15
かみちゃんさん
返事ありがとうございます。
＞これから検証しますが、今何にお困りなのでしょうか？ A42が2008/4/1の場合 「担当別シート」B列のダブらない項目を「予算シート」のB42：B48列に書き出してから、「GS（人）」「KS（人）」「金額（円）」の合計値をだす。 A52が2008/5/1の場合 「担当別」B列のダブらない項目を「予算」のB52:B52列（に書き出してから、「GS（人）」「KS（人）」「金額（円）」の合計値をだす。
ですが、現在「予算シート」の日付が消えるだけで、計算されませんでした。
＞「マクロ実行後の期待している結果」を示していただけませんか？ >> シートレイアウトやサンプルデータは、Excelシートのセル範囲をコピーして、投稿欄にそのまま
そのままはるだけでいいんですね（−−） せこせこと各項目の前に半スペースを付けたためずれてしまいました。すみません。。。
「マクロ実行後の期待している結果」を修正しました。長いために上書きをしました。 「月計」の合計値は[E]〜[H]列結合されています。
質問です ＞myKey = myVal(i, 1) & "," & myVal(i, 2) & "," & myVal(i, 3) & "," & myVal(i, 4) みちゃんさんの","と私の"_"の違いはなんでしょか？？
自分も検証しますが、よろしくお願いします。
こんにちは。かみちゃん です。
> サンプルデータに基づいた「マクロ実行後の期待している結果」 > を示していただけませんか？
修正していただいたようでありがとうございます。
シートレイアウトで確認させていただきたいのですが、
> A列の日付は > A41(2008/4/1)=DATE(J1,4,1) > A50(2008/5/1)=DATE(YEAR(B42),MONTH(B42)+1,1) > A60(2008/6/1)=DATE(YEAR(B51),MONTH(B51)+1,1) > 以降の月も同様です。
この数式、合っていますか？ B42、B51は、支店名が入るセルではないのでしょうか？ J1は、2008 と入力してあるのですか？
> [E][F]の項目名は書式設定 ＝＠"人" > [G]は書式設定＝＠"円"
「セルの書式設定」は、「ユーザー定義」で @"人" や @"円" とすると、左寄せになりますが、いいのですか？ 0"人" や 0"円" もしくは、標準のほうがいいような感じがしますが・・・
> なお、[G][H]は結合されています。
この結合している意味は何の意味ですか？ 「金額（円）」はG列で、その隣の列と結合しているのですか？
あと、予算シートであらかじめ、支店名を入力しておくことができないのは、月こどに必ず7個の支店 であるが、支店名が微妙に違うということのでしょうか？ 「担当別」シートをピボットテーブルにしてみて、数えてみました。
ちなみに、ヒボットテーブルにすると、似たような感じの表はできますね。
(かみちゃん) 2009/08/17 13:51
こんにちは。かみちゃん です。
入れ違いになりました。
今困っていることは理解できました。
>> myKey = myVal(i, 1) & "," & myVal(i, 2) & "," & myVal(i, 3) & "," & myVal(i, 4) > かみちゃんさんの","と私の"_"の違いはなんでしょか？？
どちらでもいいです。"_" に統一しておきましょうか？
> 「月計」の合計値は[E]〜[H]列結合されています
了解しました。 月計の合計値は、金額の合計でいいですよね？
(かみちゃん) 2009/08/17 13:55
かみちゃんさん
ありがとうございます。
＞この数式、合っていますか？ B42、B51は、支店名が入るセルではないのでしょうか？ 済みません指摘いただいたとおりです。列がずれていました。
> A50(2008/5/1)=DATE(YEAR(B42),MONTH(B42)+1,1) →=DATE(YEAR(A41),MONTH(A41)+1,1) > A60(2008/6/1)=DATE(YEAR(B51),MONTH(B51)+1,1) →=DATE(YEAR(A50),MONTH(A50)+1,1)
＞J1は、2008 と入力してあるのですか？ はい。入力しています。過去のデータを検索するときに便利かと追加しました。
＞「セルの書式設定」は、「ユーザー定義」で @"人" や @"円" とすると、左寄せになりますが、いいのですか？ ＞0"人" や 0"円" もしくは、標準のほうがいいような感じがしますが・・・ 標準に戻しました。
＞この結合している意味は何の意味ですか？ ＞「金額（円）」はG列で、その隣の列と結合しているのですか？ レイアウト上幅が足りなくなるため結合しています。結合しないと#####になります。
＞あと、予算シートであらかじめ、支店名を入力しておくことができないのは、 ＞月こどに必ず7個の支店であるが、支店名が微妙に違うということのでしょうか？ はいそうです。支店数は必ず７ですが、ネーミングが微妙に違います。 そのために「ダブりのない項目名」を抜き出すさないと合計ができない状態です。
＞ヒボットテーブルにすると、似たような感じの表はできますね。 そうですね。間に項目名があるので。。。。。 しかし、上司にヒボットテーブル自体却下されました。 その理由はわかりません。。。。多分使えないのではと推測しています。
＞"_" に統一しておきましょうか？ なにか意味を持っているのかと思い質問しました。同じであればどちらでも大丈夫です。
＞月計の合計値は、金額の合計でいいですよね？ はい。そうです。
>mydic.Add myKey, Array(myVal(i, 5), myVal(i, 6))
^^^^^勉強なりました。
>私は mydic.Add myKey, myVal(i, 5), myVal(i, 6)してエラーになりますが、
なぜ Array をつけることによってOKになるんでしょか？
かみちゃん さん
＞J1は、2008 と入力してあるのですか？ I1 でした。。。 [A]列と行を書くために行を追加しましたら、みんなずれてしまいました（＠。＠）
(m-o-mo) 2009/8/17/ 14:56
seiyaさん
返事ありがとうございます。
＞内容からすると、さほど複雑な処理とは思えませんが、ご提示のデータと導き出された結果の ＞関連性がわかりません。 ＞おそらく、元データと結果は違うデータを使用しているのかと思いますがそこまでは読めません。 説明が下手で済みません。。。。
> myVal = WS1.Range("A2", Range("A" & Rows.Count).End(xlUp)).Value
> myKey = myVal(i, 1) & "_" & myVal(i, 2) & "," & myVal(i, 4)
＞myValにはA列のデータしか入っていません。したがってmyVal(i, 2)は意味をなしません。
なぜA列の内容が消えたかなぞか解けました。私がそう設定したからですね。。。。
こんにちは。かみちゃん です。
少し2時間弱外出していましたので、遅くなりました。
簡単に答えることだけ。
>>私は mydic.Add myKey, myVal(i, 5), myVal(i, 6)してエラーになりますが、 >なぜ Array をつけることによってOKになるんでしょか？
DictionaryオブジェクトのItemには配列にすることもできるからです。 今回は、ひとつのKeyで、人数と金額を配列にすることで、mydicとmydic2という2つのオブジェクトを 持たなくてもいいようにしています。
日付の数式の訂正は、理解しました。
(かみちゃん) 2009/08/17 15:43
かみちゃん さん
ありがとうございます。
＞少し2時間弱外出していましたので、遅くなりました。 かみちゃんさんの空いている時間で大丈夫です。 私は家にインタネット使用できる環境にないため、17：15以降の回答は翌日にさせてください。
>DictionaryオブジェクトのItemには配列にすることもできるからです。 一つ勉強になりました。
質問です。
.Columnsの意味を調べたところ。 1.範囲にある列 1 のすべてのセルの値を 0 に設定します。 2.結合されたセルを戻す
Ｑ1.意味合いが1の場合何のために値を 0 に設定するのですか？
Ｑ2.意味が2の場合
myVal(i, lngColumnMax) = 0
For j = 5 To lngColumnMax - 1
^^^？？なぜ５からでしょか？
myKey = myVal(i, lngColumnMaxlngColumnMax + 1) & "," & myVal(i, 2) & "," & myVal(1, j) & "," & GK
^^^^^^^^^^^^^^^^^^^^^^^^BとC列の結合を解くという意味でしょか？
If mydic.Exists(myKey) Then
myVal(i, j) = mydic(myKey)(1)
myVal(i, lngColumnMax) = myVal(i, lngColumnMax) + mydic(myKey)(0)
End If
(m-o-mo) 2009/8/17 17：02
こんにちは。かみちゃん です。
> .Columnsの意味を調べたところ。 > 1.範囲にある列 1 のすべてのセルの値を 0 に設定します。 > > Ｑ1.意味合いが1の場合何のために値を 0 に設定するのですか？
これは、Columns プロパティのヘルプの引用だと思いますが、
---(引用ここから)---
次の使用例は、"myRange" という名前のセル範囲にある列 1 のすべてのセルの値を 0 に設定します。
Range("myRange").Columns(1).Value = 0
---(引用ここまで)---
ですから、「何のために0に設定するのか」は、ヘルプの使用例上の説明です。 何のためにではなく、上記引用のコードでは、myRangeという名前定義されたセル範囲の1列目の値を 0 にする という意味です。
> 2.結合されたセルを戻す
この説明は、どこで調べられたのでしょうか？
> For j = 5 To lngColumnMax - 1 > ^^^？？なぜ５からでしょか？
予算シートの数値集計開始位置がE列（GS （人））からだからです。
> myKey = myVal(i, lngColumnMaxlngColumnMax + 1) & "," & myVal(i, 2) & "," & myVal(1, j) & "," & GK > ^^^^^^^^^^^^^^^^^^^^^^^^BとC列の結合を解くという意味でしょか？
そのような記述は、どこにしていますでしょうか？
myKey = myVal(i, lngColumnMax + 1) & "," & myVal(i, 2) & "," & myVal(1, j) & "," & GK
という記述しかないと思うのですが？
(かみちゃん) 2009/08/17 17:15
かみちゃんさん
返答ありがとうございます。すみません。馬鹿丸出しですね（汗汗）
＞＞ 2.結合されたセルを戻す ＞ この説明は、どこで調べられたのでしょうか？ インターネットです。セルをクリア設定にColumnが使用されていたので、勘違いしてました。
＞myVal(i, lngColumnMax) = 0 の意味理解できました。 lngColumnMaxは配列の名前ですね。 いままで配列はiとｊとｘとｙで使用していましたので、 難しく考えてしまいました。（´ｘ｀）
こんにちは。かみちゃん です。
> lngColumnMaxは配列の名前ですね。 > いままで配列はiとｊとｘとｙで使用していました
配列の名前ではありません。名前は、myVal です。 lngColumnMax や i、j、x、y などは、配列の添え字というものです。
さて、本題ですが、転記先である「予算」シートのレイアウトに合わせるのが結構難しいですね。 まったく白紙のシートに「予算」シートと同じ結果を出力するのではいけないのでしょうか？
また、「担当別」シートの年月日は昇順等に並べ替わっていないということでいいのでしょうか？
それと、m-o-moさんが最初提示されたコードをできるだけ活かそうとすると、たぶん難しそうなので、 Dictionaryオブジェクトを使う方法で別の方法を提案させていただいてはいけませんか？ ただし、それも必ずしもスマートではないかもしれませんが。
(かみちゃん) 2009/08/18 9:00
m-o-moさん 1) 定型シートに流し込む 2) ヘッダーは既に入力済み > 1.A列の年月日の地名を抜け出す（毎月決まって７項目しかありません。内容は微妙に違います。） > 2.各地名の[E]と[F]の人数を合計 > （[E][F]のGS＆KSはSheets2の[C]列の項目名。合計値は[F]列の人数） > 3.[G]列は金額の合計 > （Sheets2のGKさんのデータのみ。合計値は[E]金額です。） これは変わりませんか？ (seiya)
＞レイアウトに合わせるのが結構難しいですね やはりそうですか。。。レイアウトが問題ですね。（´ｘ｀）
＞別の方法を提案させていただいてはいけませんか？ ＞ただし、それも必ずしもスマートではないかもしれませんが。 それは結果出せるなら。。。 ただ難しすぎますと変更になったりするたんびにかみちゃんさんの手を借りなくてはならない事態になります。。。。
もちろん理解する努力はします。。。
こんにちは。かみちゃん です。
>> レイアウトに合わせるのが結構難しいですね > やはりそうですか。。。レイアウトが問題ですね。（´ｘ｀）
Dictionaryオブジェクトのよいところは、集計結果のフォーマットが決まっているところに集計できる というところだと思います。 そのためレイアウトを変えてくださいとは申し上げませんが、変えられる、もしくは、集計結果が同じ であれば、白紙から始めてもいいのかなと思い、聞いてみました。 今は、「予算」シートの所定の位置に入れていくところに四苦八苦していますので・・・
(かみちゃん) 2009/08/18 9:37
返事ありがとうございます。
＞これは変わりませんか？ 変わらないです。↓イメージはこんな感じです。
A42が2008/4/1の場合 「担当別」B列のダブらない項目を「予算」のB41：B47列（指定した範囲内）に書き出 す。 A52が2008/5/1の場合 「担当別」B列のダブらない項目を「予算」のB50:B56列（指定した範囲内）に書き出す。
なお、シートのレイアウトは2番目の掲示が正しいです。 ただ、高度なコードになりそうですね、、、、、、
>ただ、高度なコードになりそうですね そんなことは無いと思いますよ？ (seiya)
こんにちは。かみちゃん です。
seiyaさんに対するコメントですが、疑問に感じたことがあるので、教えてください。
> A42が2008/4/1の場合 > 「担当別」B列のダブらない項目を「予算」のB42：B48列（指定した範囲内）に書き出 す。 > A52が2008/5/1の場合 > 「担当別」B列のダブらない項目を「予算」のB52:B52列（指定した範囲内）に書き出す。
2番目のシートのレイアウトでは、以下のように行番号を振っていただき説明を受けていますが、 行番号がひとつずつずれていませんか？ 掲示が正しいのか、説明文が正しいのかどちらですか？
[A] [B] [C] [D] [E] [F] [G] [H] [39] 月別内訳 [40] 月 支店 伝表発行 GS （人） KS （人 ） 金額 （円） [41] 2008/4/1 （m-o-mo） 0 [42] （m-o-mo） 0 [43] （m-o-mo） 0 [44] （m-o-mo） 0 [45] （m-o-mo） 0 [46] （m-o-mo） 0 [47] （m-o-mo） 0 [48] 月計 [49] 月 支店 伝表発行 GS （人） KS （人） 金額 （円） [50] 2008/5/1 （m-o-mo） 0 [51] （m-o-mo） 0
私は、サンプルシートを作って検証していますので、このあたりは、しっかりとお伝えいただきたいです。
> ただ、高度なコードになりそうですね
私も高度だとは思っていません。 私の頭が固いだけですので、難しく考えないほうがいいと思いますが、高度かどうかは人それぞれでしょうね。
(かみちゃん) 2009/08/18 9:58
ありがとうございます。
>「予算」シートの所定の位置に入れていくところに四苦八苦していますので・・・ すみませんお手数かけました。＞＜
>行番号がひとつずつずれていませんか？ あ！ずれてます。修正します。
＞私の頭が固いだけですので、難しく考えないほうがいいと思いますが、高度かどうかは人それぞれでしょうね。 そうですね、構えてばかりでは前進みませんね。 一つお願いですが、配列の添え字を行と列がわかるものにしていただけますととっても助かります。 例えが、IngBretuMaxですとかIngBgyoMaxだめですかね、、 ＾＾；；；；；
すみません範囲がずれていました。
A42が2008/4/1の場合 「担当別」B列のダブらない項目を「予算」のB41：B47列（指定した範囲内）に書き出 す。 A52が2008/5/1の場合 「担当別」B列のダブらない項目を「予算」のB50:B56列（指定した範囲内）に書き出す。
>そんなことは無いと思いますよ？ 理解できるようがんばります。p(￣ ￣)q
こんにちは。かみちゃん です。
> 配列の添え字を行と列がわかるものにしていただけますととっても助かります。 > 例えが、IngBretuMaxですとかIngBgyoMaxだめですか
変数名の要望には応えられていませんが、動作としては以下のような感じでていいのではないでしょうか？ コードの理解も大事ですが、まずは、集計がきちんと期待とおりに出来ているか確認していただけませんか？ その後、コードの説明、変数名の変更はいくらでもお聞きします。 なお、コードの説明をお尋ねいただく際は、ヘルプ等を調べていただいて、お尋ねいただいたほうがいいと思います。
Sub Sample2() Dim WS1 As Worksheet Dim WS2 As Worksheet Dim myVal As Variant Dim myKey As String Dim mydic As Object Dim i As Long Dim j As Long Dim k As Long Dim lngColumnMax As Long Dim dblSum As Double Dim x As Long Dim y As Long Dim rngResult As Range Dim vntKey As Variant Dim c As Range Dim m As Variant
Const GK As String = "GK"
Set WS1 = Workbooks("dt.xls").Sheets("担当別")
Set WS2 = Workbooks("集計.xls").Sheets("予算")
'元データを日付順に並べ替え（最後に元の順番に戻す）
With WS1.Range("A2", WS1.Range("A" & Rows.Count).End(xlUp)).Resize(, 8)
myVal = .Value
For i = 1 To UBound(myVal, 1)
myVal(i, 7) = Format(CDate(Replace(myVal(i, 1), ".", "/")), "gee.mm")
myVal(i, 8) = i
Next
.Columns(7).Value = WorksheetFunction.Index(myVal, 0, 7)
.Columns(8).Value = WorksheetFunction.Index(myVal, 0, 8)
.Sort Key1:=.Cells(2, 7), Order1:=xlAscending, _
Key2:=.Cells(2, 8), Order2:=xlAscending, Header:=xlYes
myVal = .Value
.Sort Key1:=.Cells(2, 8), Order1:=xlAscending, Header:=xlYes
.Columns(8).Delete Shift:=xlToLeft
.Columns(7).Delete Shift:=xlToLeft
End With
'転記先データの範囲の取得と集計キーの編集
Set rngResult = WS2.Range("A40:G149")
lngColumnMax = rngResult.Columns.Count
vntKey = rngResult.Rows(1).Value
For j = 5 To lngColumnMax - 1
vntKey(1, j) = Replace(vntKey(1, j), " （人）", "")
vntKey(1, j) = Replace(vntKey(1, j), " （人 ） ", "")
Next
'集計用配列変数の確保
ReDim myVal2(1 To rngResult.Rows.Count, 1 To rngResult.Columns.Count)
'元データの読み込み
Set mydic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(myVal, 1)
If myVal(i, 4) = GK Then
myKey = myVal(i, 7) & "," & myVal(i, 2) & "," & "," & GK
If Not mydic.Exists(myKey) Then
x = x + 1
mydic.Add myKey, x
End If
y = mydic(myKey)
myVal2(y, 1) = myVal(i, 7)
myVal2(y, 2) = myVal(i, 2)
For j = 5 To lngColumnMax - 1
If myVal(i, 3) = vntKey(1, j) Then
myVal2(y, j - 1) = myVal2(y, j - 1) + myVal(i, 6)
myVal2(y, lngColumnMax - 1) = myVal2(y, lngColumnMax - 1) + myVal(i, 5)
End If
Next
End If
Next
With rngResult
'転記先配列を確保
myVal = .Resize(, .Columns.Count - 1).Offset(, 1).Value
For Each c In .Columns(1).SpecialCells(xlCellTypeFormulas, 1)
If IsDate(c.Value) Then
'前回の集計済みデータの消去
c.Resize(8).Offset(, 1).ClearContents
On Error Resume Next
c.Resize(8).EntireRow.SpecialCells(xlCellTypeConstants, 1).ClearContents
On Error GoTo 0
'集計結果を転記先配列に格納
m = Application.Match(Format(c.Value, "gee.mm"), WorksheetFunction.Index(myVal2, 0, 1), 0)
If IsNumeric(m) Then
k = c.Row - rngResult.Rows(1).Row + 1
dblSum = 0
For i = 1 To 7
myVal(k + i - 1, 1) = myVal2(m + i - 1, 2)
For j = 5 To lngColumnMax
myVal(k + i - 1, j - 1) = myVal2(m + i - 1, j - 1)
Next
'月計を計算
dblSum = dblSum + myVal(k + i - 1, lngColumnMax - 1)
Next
'月計を配列に格納
myVal(k + i - 1, 4) = dblSum
End If
End If
Next
'転記先へ出力
.Resize(, .Columns.Count - 1).Offset(, 1).Value = myVal
End With
Set mydic = Nothing MsgBox "集計が完了しました" End Sub
ちなみに、この手法は、ここの「エクセルの学校」で学びました。
(かみちゃん) 2009/08/18 10:34
こんな感じで、どうですか？
月計の計算式が不明だったので、その部分は手を付けていません。
Sub test()
Dim a, b, i As Long, ii As Long, iii As Long, myInd As Long
Set wsData = Workbooks("dt.xls").Sheets("担当別")
Set wsSummary = Workbooks("集計.xls").Sheets("予算")
a = wsData.Range("a1", wsData.Range("a" & Rows.Count).End(xlUp)).Resize(, 6).Value2
With wsSummary.Range("a40", wsSummary.Range("a" & Rows.Count).End(xlUp)).Resize(, 9)
On Error Resume Next
.Offset(, 1).SpecialCells(2, 1).ClearContents
'On Error GoTo 0
b = .Value2
End With
For i = 3 To UBound(b, 1) Step 9
For ii = 2 To UBound(a, 1)
If (Year(a(ii, 1)) = Year(b(i, 1))) * (Month(a(ii, 1)) = Month(b(i, 1))) Then
myInd = 0
For iii = 5 To 7 Step 2
If a(ii, iii) = b(i, 3) Then
myInd = iii : Exit For
End If
Next
If myInd > 0 Then
For iii = i To i + 6
If (b(iii, 2) = "") + (b(iii, 2) = a(ii, 2)) Then
b(iii, 2) = a(ii, 2) : b(iii, myInd + 1) = b(iii, myInd + 1) + a(i, 6)
If a(i, 4) = "GK" Then
b(iii, 9) = b(iii, 9) + a(i, 5)
'月計の式が不明
End If
Exit For '<- 追加
End If
Next
End If
End If
Next
Next
wsSummary.Range("a40").Resize(UBound(b, 1), 9).Value = b
Set wsData = Nothing : Set wsSummary = Nothing
End Sub
(seiya)
返答ありがとうございます。
＞変数名の要望には応えられていませんが、動作としては以下のような感じでていいのではないでしょうか？ ＞コードの理解も大事ですが、まずは、集計がきちんと期待とおりに出来ているか確認していただけませんか？ ＞その後、コードの説明、変数名の変更はいくらでもお聞きします。 ＞なお、コードの説明をお尋ねいただく際は、ヘルプ等を調べていただいて、お尋ねいただいたほうがいいと思います。 了解です。
早速試したところエラー発生しました。
'転記先配列を確保
myVal = .Resize(, .Columns.Count - 1).Offset(, 1).Value
For Each c In .Columns(1).SpecialCells(xlCellTypeFormulas, 1)
If IsDate(c.Value) Then
'前回の集計済みデータの消去
c.Resize(8).Offset(, 1).ClearContents
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ← エラー発生
マクロ エラー 実行中のマクロにエラーが発生しました。次のいずれかの理由により、 指定したメソッドは指定したオブジェクトで使用できません。等
こんにちは。かみちゃん です。
> c.Resize(8).Offset(, 1).ClearContents > ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ ← エラー発生
Excelのバージョンを教えていただけますか？ もしかして、Excel2007であれば、以下を参考にしてみてください。http://office.microsoft.com/ja-jp/help/HP100141151041.aspx現在参照不可
こちらでは、Excel2002 SP3 で動作確認しています。
(かみちゃん) 2009/08/18 11:08
回答ありがとうございます。
＞Set wsData = Workbooks("dt.xls").Sheets("Sheets2")
をSet wsData = Workbooks("dt.xls").Sheets("担当別")に変更しました。すみません＞＜
＞If (b(iii, 2) = "") + (b(iii, 2) = a(ii, 2) Then
〔〕が足りないとエラー発生したところIf (b(iii, 2) = "") + (b(iii, 2) = a(ii, 2)) Then 付け足しました。
＞If a(ii, iii) = b(i, 3) Then
このエラーはわかりませんでした。
エラー箇所に当てると「インデックス有効範囲にありません」をコメントが、、、
ii＝198
iii＝7 になていました。
こんにちは。かみちゃん です。
衝突しましたが、そのまま載せておきます。
To,seiyaさん
私から指摘するのは、大変おこがましいことですが、一部コンパイルチェックでエラー、 および実行時エラーになるコードがありますので、書かせていただきます。
If (b(iii, 2) = "") + (b(iii, 2) = a(ii, 2) Then
は、
If (b(iii, 2) = "") + (b(iii, 2) = a(ii, 2)) Then
^^^
で、
ws.Summary.Range("a40").Resize(UBound(b, 1), 9).Value = b
は、
wsSummary.Range("a40").Resize(UBound(b, 1), 9).Value = b
^^^^^^^^^^
ではないかと思います。
また、seiya さんのコードでは、
Workbooks("dt.xls").Sheets("Sheets2")
となっているシート（後に"担当別"と名前が変わっていますが、）
のA列は、日付型を示すシリアル値をセルの書式設定で「H20.4」と表示していると理解されているようです。
To, m-o-moさん
このあたりは、私も知りたいところです。 私のコードでは、文字列であるものとして扱っていて、もし、シリアル値であれば、もう少しコードが 変わってきます。
(かみちゃん) 2009/08/18 11:18
衝突ばっか！ m-o-moさん コードを修正しましてので最後まで走らせて見てください。 (seiya)
回答ありがとうございます。
＞Excelのバージョンを教えていただけますか？
wd XP エクセル2000です。
＞Workbooks("dt.xls").Sheets("担当者")
>A列は、日付型を示すシリアル値をセルの書式設定で「H20.4」と表示していると理解されているようです。
説明不足で済みません。A列は、日付型を示すシリアル値をセルの書式設定で「H20.4」と表示しています。
>wsSummary.Range("a40").Resize(UBound(b, 1), 9).Value = b
^^^^^^^^^^
ありがとうございます。修正しました＾＾
こんにちは。かみちゃん です。
> エクセル2000です。
であれば、とりあえず、 c.Resize(8).Offset(, 1).ClearContents のコードは削除して実行してみてください。（前回のデータを消去しているだけですので）
原因は、調べてみますが、こちらでは発生しません。 ちなみに、月計とG列とH列以外で結合しているセルはありませんよね？ 結合セルとVBAは相性が悪いので、その特性を考慮したコードにしないといけません。
> A列は、日付型を示すシリアル値をセルの書式設定で「H20.4」と表示しています。
どのような質問でも、結構大事な情報ですので、今後、配慮していただければと思います。
(かみちゃん) 2009/08/18 11:38
かみちゃんさん
回答ありがとうございます。
＞月計とG列とH列以外で結合しているセルはありませんよね？ あ！BとC結合してます。はずしました。
'転記先配列を確保
myVal = .Resize(, .Columns.Count - 1).Offset(, 1).Value
For Each c In .Columns(1).SpecialCells(xlCellTypeFormulas, 1)
^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^がエラーになりました。
選択範囲があいまいだそうです。
ねんのため結合箇所を掲載します。 項目名（39行目と76行目113行目）「月別内訳」はA〜H列結合しています。 月計項目は＝A〜D結合されています。 月計の合計値＝E〜H結合されています。 以上結合箇所です。
今回使用していない1〜38行のものは関係ないですよね？
>どのような質問でも、結構大事な情報ですので、今後、配慮していただければと思います。 すみませんでした。
混乱しているようなので、私はここで降ります。 (seiya)
> 混乱しているようなので、
コンパイルしてないコードをどんどんアップされても 混乱しますです(泣)
こんにちは。かみちゃん です。
> コンパイルしてないコードをどんどんアップされても 混乱しますです
ちなみに、私は、コンパイルチェックも動作確認もしたうえで、提示しています。 結合セルの情報、日付データの情報など、後から明らかになってくるので、その都度検証しなおしが 発生しています。
ファイルが直接見れればどれだけ楽か・・・とさえ思えます。 ちなみに、seiyaさんは、コンパイルチェックできない環境だそうなので、許してあげてください。
(かみちゃん) 2009/08/18 12:06
こんにちは。かみちゃん です。
> '転記先配列を確保 > myVal = .Resize(, .Columns.Count - 1).Offset(, 1).Value > For Each c In .Columns(1).SpecialCells(xlCellTypeFormulas, 1) > ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^がエラーになりました。 > 選択範囲があいまいだそうです。 > > ねんのため結合箇所を掲載します。 > 項目名（39行目と76行目113行目）「月別内訳」はA〜H列結合しています。 > 月計項目は＝A〜D結合されています。 > 月計の合計値＝E〜H結合されています。 以上結合箇所です。 > > 今回使用していない1〜38行のものは関係ないですよね？
状況がよくほかりませんので、勝手ながら、こちらで作ったサンプルファイルを以下にアップさせていただきますので、このファイルでご確認していただけますでしょうか？ http://kamicha1.web.fc2.com/Excel/m-o-mo20090818.html （便宜上、同一ブックにシートをまとめてあります。）
このファイルで動作確認ができて、m-o-moさんのお手元のファイルでできない場合は、シートレイアウトか、設定が違うと思われます ので、内容を見てみないとわかりません。
(かみちゃん) 2009/08/18 12:17
>> 混乱しているようなので、
> コンパイルしてないコードをどんどんアップされても 混乱しますです(泣) この発言は m-o-mo さんからかな？ もしそうでないのなら、何らかの解決策を提示してからにしたらどうなの？ (seiya)
こんにちは。かみちゃん です。
> もしそうでないのなら、何らかの解決策を提示してからにしたらどうなの？
誤解があってはいけませんので、一言。 その発言、私ではありません。
(かみちゃん) 2009/08/18 12:23
> 誤解があってはいけませんので、一言。 > その発言、私ではありません。
そのようなことは思っていません。 私はこのような発言を適当なHNで身を隠してする輩が無くなってほしいだけです。 (seiya)
＞コンパイルしてないコードをどんどんアップされても 混乱しますです(泣) 私でもないです（＾＾；； 以前にコメント自体気づいてない・・・・・・。
(m-o-mo)
m-o-moさん
>衝突ばっか！ >m-o-moさん >コードを修正しましてので最後まで走らせて見てください。 >(seiya)
とりあえず、一休みします。 (seiya)
＞混乱しているようなので、 混乱はしていませんが、せっかく作っていただいたコードに対して一つずつ解読しています。 ただ、私の理解力が低いため時間はかかることをお許しください。
＞コンパイルしてないコードをどんどんアップされても 混乱しますです(泣) コメント自体気づかず皆さんに不愉快な思いをさせすみません。（＞＜） このコメントは回答者でも質問者のものでもないようなので、今後スルーさせてください。
検証結果 エラーはおこりませんでしたが、不思議な結果になっています。 どうも私のレイアウトに問題があるようで、今検証しています。
一つ質問ですが seiya さんのコードは 1.Ｂ列の項目を抜き出し、ＥとＦとＧ＆Ｈの合計を出す。 2.Ｂ列の項目を抜き出す。 どちらでしょか？ 月計は了解です。ＳＵＭで対応していますので問題ありません。 よろしくお願いします。
(m-o-mo)
なにやら少し席離れてる間に不穏なコメントで不愉快させすみませんでした。
かみちゃんさんのファイルは正常に計算されています。 どうやら私のファイルのほうが問題のようですね。 調べますので少しお時間ください。
(m-o-mo)
こんにちは。かみちゃん です。
私は、不愉快な思いは、していませんので、大丈夫ですよ。
> ファイルは正常に計算されています
であれば、ひと安心です。
> 調べますので少しお時間ください。
こちらでは、これ以上解析ができませんので、お待ちするしかなさそうですね。 一番いいのは、ファイルを見せていただくのが早いかと。。。
> 月計は了解です。ＳＵＭで対応しています
これ、どこかで説明されていましたか？ 私のコードでは、コード内で集計しています。
(かみちゃん) 2009/08/18 14:06
かみちゃん さん
回答ありがとうございます。
＞月計は了解です。ＳＵＭで対応しています はseiya さんの月計不明に対しての回答です。
＞一番いいのは、ファイルを見せていただくのが早いかと。。。 参考にファイルのアップはどんな方法ありますか？
(m-o-mo)
こんにちは。かみちゃん です。
>>月計は了解です。ＳＵＭで対応しています > >はseiya さんの月計不明に対しての回答です。
それは、わかっているのですが、月計は、SUM関数ですでに求めるようにしているのか？と思い、 そういう説明はないような気がしましたので、聞いてみました。 SUM関数で求めているのか、これから対応するのかどちらですか？
> 一番いいのは、ファイルを見せていただくのが早いかと。。。 > 参考にファイルのアップはどんな方法ありますか？
私は、自分のHPエリアを持っているので、送っていただければ、エリアをお貸しすることはできます。 送り先は、さきほど、ファイルを公開したところに記載しています。
もしくは、以前、他の方は、以下のようなところを利用されているのも見たことがあります。 ただし、ご利用は、自己責任で対応していただきたいと思います。 http://firestorage.jp/
(かみちゃん) 2009/08/18 14:29
1) 定型シート(予算シート)のA42から9行づつループさせています。（日付セル） 2) 担当別シートをループしてA列の日付の 年月が定型シートの日付の年月と同じ行を検索 一致行があった場合、 予算シートのヘッダー(日付セルの一行上)にあるE列かG列（項目？）の値と 担当別シートのC列の値が一致するかどうか確認。
確認された場合、 予算シートの日付行のB列からその行+6の位置までループして、空白または 担当別シートのB列の値と一致した場合 予算シートの該当ヘッダーの同行の値に担当別シートのF列の値を加算。 担当別シートのD列が "GK"の場合、予算シートのI列の値に担当別シートのE列 の値を加算。
という具合になっているはずです。
If myInd > 0 Then
For iii = i To i + 6
If (b(iii, 2) = "") + (b(iii, 2) = a(ii, 2)) Then
b(iii, 2) = a(ii, 2) : b(iii, myInd + 1) = b(iii, myInd + 1) + a(i, 6)
If a(i, 4) = "GK" Then
b(iii, 9) = b(iii, 9) + a(i, 5)
'月計の式が不明
End If
Exit For '<- これを追加してください。
End If
Next
End If
(seiya)
＞SUM関数で求めているのか、これから対応するのかどちらですか？ かみちゃんさんのコード検証シートには月計は空欄です。(シート担当者） seyaさんのコード検証シートには月計はSUM関数入っています。(シート担当者2）みたいな。
＞私は、自分のHPエリアを持っているので、送っていただければ、エリアをお貸しすることはできま す。 ＞ 送り先は、さきほど、ファイルを公開したところに記載しています。
ファイル添付のところ「参照」ボタンで私のパソコンのファイルをクリックするだけでいいのですね。 了解です。やってみてだめな場合は送ります。もう少し時間をください。
(m-o-mo)
seiya さん
ありがとうございます。 サイド検証してみます。少し時間をください。 (m-o-mo)
こんにちは。かみちゃん です。
> コード検証シートには月計は空欄です。
了解しました。 なお、「月計」のセルは、シート担当者ではなく、「予算」シートです。
> ファイル添付のところ「参照」ボタンで私のパソコンのファイルをクリックするだけでいいのですね。 > 了解です。やってみてだめな場合は送ります。
わかりましたが、内容に、会社情報等個人情報に関わるものは、含めないように注意してください。 あくまで、m-o-moさんの責任で、公開されるようお願いします。
(かみちゃん) 2009/08/18 14:52
seiya さん
回答ありがとうございます。
コードを検証しました。 シンプルなコードなので興味津々でやりましたが、奥が深いですね。
検証結果 いろいろ試したところB列の項目のみ抜き出されます。 8月〜１１月は7項目抜き出されましたが、 12月〜３月は６項目まではOKですが、７項目目は空欄になります。。。。
(m-o-mo）
こんにちは。かみちゃん です。
さて、私が提示したコードで、m-o-moさんのファイルでは、動くようになったのでしょうか？ Dictionaryを使っているせいか、seiyaさんに比べて、シンプルではありませんが、結構気になっているので、 一度は、そちらのファイルを拝見したいです。 あと、25分で今日もお仕事終わりですよね？ とりあえず、お待ちしていることを気に留めていただけるとうれしいです。
(かみちゃん) 2009/08/18 16:50
あ！すれ違いですね。コードは完璧です。思い通りの結果になりました。
いろいろ検証したところ集計されない理由は多分
1.("dt.xls").Sheets("担当別")データが変になった行を削除しました。
2.集計シートGS（人）・KS（人 ） と GS・ KS と思われます。
と思われます。その箇所を直したところ、無事に計算しました。 明日本物のデータを当てて集計してみます。
ながながとお付き合い本当にありがとうございます。m(_ _)m 2ヶ月間にわたりマクロで集計これにて完成しました。本当にありがとうございます。 今後また何かありましたらよろしくお願いします。
(m-o-mo）
> 検証結果 >いろいろ試したところB列の項目のみ抜き出されます。
他に抜き出すべき値はどのような値でしょう？
>8月〜１１月は7項目抜き出されましたが、 >12月〜３月は６項目まではOKですが、７項目目は空欄になります。。。。
私自身まだ質問内容をはっきり理解していないような気がします。
マクロ実行結果と、希望結果の違いがわかるようにアップしていただけませんか？ (seiya) 追伸： 解決されたようですので、上記コメントはスルーしてください。
こんにちは。かみちゃん です。
> 1.("dt.xls").Sheets("担当別")データが変になった行を削除しました。
この意味がよくわかりません。 つまり、掲示板に載せていたデータと、シートレイアウトがお手元のデータが違うところがあったということでしょうか？
> 2.集計シートGS（人）・KS（人 ） と GS・ KS と思われます。
これは気になっていましたが、コード内でわざと編集していますが、m-o-moさんがおっしゃっている 不具合状況には影響ないと思っています。
ただし、その部分は、seiyaさんのコードですと、重要な位置付けになりますので、私のコードで解決 しても、結局seiyaさんに対して、質問を続けられるならば、しっかりとシートレイアウトを伝えるべき と思っています。 そのために、ファイルを拝見したいと「お待ちしていた」わけです。
ちなみに、seiyaさん提示のコードでは、私がアップしたファイルを使うと集計結果が全然違います。 このあたりは、何が違うのか、原因を調べることはできますが、私はその立場にはありませんので、 控えさせていただきます。 （ロジックとしては、一例として勉強するに値するものです。私も勉強しようと思っています）
なお、本来の質問は、Dictionaryについてでしたよね？ seiyaさんのコードは、それが使われていない、つまり、使わなくてもできるということはご理解いただければと思っています。
(かみちゃん) 2009/08/18 17:14
昨日返信できなくて済みません＞＜急に仕事が立て込んでしまいました。
＞解決されたようですので、上記コメントはスルーしてください。 seiyaさんが教えていただいたコードは謎のままです（TｗT) 私は今回Dictionaryにこだわったのはそれしかわからないからです＾＾；； seiyaさんのコードを見てちょっと衝撃。 もしご迷惑でなければレスの続きをしていただけませんか？ よろしくお願いします。m(_ _)m
あ！その際に新しい質問としてさせてください。よろしくお願いします。
(m-o-mo） 2009/8/19 9：09
かみちゃん さん
お待たせしたまま返信できずに済みません。
＞Dictionaryを使っているせいか、seiyaさんに比べて、シンプルではありませんが、 それは私のお願いなので、、、逆に申し訳ないぐらいです。
＞掲示板に載せていたデータと、シートレイアウトがお手元のデータが違うところがあったということでしょうか？ いえ！必要ないデータ消したつもりが一部分残っている状態でしたので。それかなと思いましたが。 思い違いでした。。。今朝再度集計したところまたエラーになりましたので・・・・・
データの送付はこれからでも大丈夫でしょか？？
>一例として勉強するに値するものです。私も勉強しようと思っています はい私も同じです。seiyaさんが続きのレスをしていただけるとうれしいです。
(m-o-mo） 2009/8/19 9:27
こんにちは。かみちゃん です。
> データの送付はこれからでも大丈夫でしょか？？
大丈夫ですよ。
(かみちゃん) 2009/08/19 9:29
m-o-moさん
Dictionaryを使用しない方法もマスターしておきたいとお思いでしたら、どうぞお続けください。 Macとか、何らかの原因でScripting.Runtimeの参照設定が外れている場合はDictionaryが使用 できなくなるケースもありますので。 (seiya)
こんにちは。かみちゃん です。
ちょっと確認したいことがあります。
> 2.各地名の[E]と[F]の人数を合計 > （[E][F]のGS＆KSは担当別の[C]列の項目名。合計値は[F]列の人数） > 3.[G]列は金額の合計 > （担当別のGKさんのデータのみ。合計値は[E]金額です。）
人数は、担当別のD列の"GK"だけでなく"GG"や"GM"など、すべてのデータについてE列とF列の項目別に集計し、 金額は、担当別のD列のうち"GK"のみ集計するのですか？
それであれば、私のコード間違っています。 必要であれば、訂正しますので、教えてください。
(かみちゃん) 2009/08/19 10:22
こんにちは。かみちゃん です。
m-o-moさんより、 > データをアップお願いします と連絡を受けましたので、以下にアップさせていただきます。 http://kamicha1.web.fc2.com/Excel/m-o-mo20090818.html Syuukei20090819.zip をダウンロードしていただき解凍していただくと、集計.xls が現れます。 （便宜上、同一ブックにシートをまとめてあり、予算シートにボタンを付けています。）
なお、seiyaさんのコードは、 > 項目名（39行目と76行目113行目）「月別内訳」はA〜H列結合 の対応ができていないのではないでしょうか？ 4ヶ月分処理したら1行加算しないといけないような気がします。
(かみちゃん) 2009/08/19 10:55
かみちゃん さん
ありがとうございます。 ＞それであれば、私のコード間違っています。 ＞必要であれば、訂正しますので、教えてください。 そのままで大丈夫です＾＾数字はあってました。 最後の最後までドタバタと済みません。 結果的に無事に計算できたことがうれしいです。 なぜエラーが発生したのは不思議でしたが、 いただいたコードを元にこれから勉強したいと思います。 躓いたときは又質問に来ますのでそのときもよろしくお願いします。 ほんとうにありがとうございました。
(m-o-mo） 2009/8/19 11：21
こんにちは。かみちゃん です。
>> それであれば、私のコード間違っています。 >> 必要であれば、訂正しますので、教えてください。 > そのままで大丈夫です＾＾数字はあってました。
それであれば [[20090819104249]]『VBA で集計』（m-o-mo） に移られて、seiyaさんのコードにも挑戦されるご様子ですが、きちんと説明されたほうがいいですよ。
seiyaさんのコードは、 >> 人数は、担当別のD列の"GK"だけでなく"GG"や"GM"など、すべてのデータについてE列とF列の項目別に集計し、 >> 金額は、担当別のD列のうち"GK"のみ集計する になっていますから。 そこの説明がつじつまが合っていません。どっちなの？という感じです。
では、後はがんばってください。 私もDictionaryを使わない方法、勉強してみます。
(かみちゃん) 2009/08/19 11:28
少々訂正してMsgBoxを追加しましたので、試してください。
Sub test()
Dim a, b, i As Long, ii As Long, iii As Long, myInd As Long
Dim wsData As Worksheet, wsSummary As Worksheet, myYear As Long, myMonth As Long
Set wsData = Workbooks("dt.xls").Sheets("担当別")
Set wsSummary = Workbooks("集計.xls").Sheets("予算")
a = wsData.Range("a1", wsData.Range("a" & Rows.Count).End(xlUp)).Resize(, 6).Value2
With wsSummary.Range("a39", wsSummary.Range("a" & Rows.Count).End(xlUp)).Resize(, 9)
On Error Resume Next
.Offset(, 1).SpecialCells(2, 1).ClearContents
'On Error GoTo 0
b = .Value2
End With
For i = 3 To UBound(b, 1)
If (b(i, 1) <> "") * IsDate(b(i, 1)) Then
myYear = Year(b(i, 1)) : myMonth = Month(b(i, 1))
MsgBox CDate(b(i, 1)) & " found on row " & i + 38 & " in 予算" & vbLf
"Loop in 担当別 to summarize " & myYear & "." & myMonth & " data starts"
For ii = 2 To UBound(a, 1)
If (Year(a(ii, 1)) = myYear) * (Month(a(ii, 1)) = myMonth) Then
MsgBox CDate(a(ii, 1)) & " found on the row " & i
myInd = 0
For iii = 5 To 7 Step 2
If a(ii, 3) = b(i - 1, iii) Then
myInd = iii : Exit For
End If
Next
If myInd > 0 Then
MsgBox "Person matched with " & b(i - 1, 3) & vbLf _
"Check if the item is already listed, if not, put new item in a first blank" & _
" within next 7 rows from the date in 予算."
For iii = i To i + 6
If (b(iii, 2) = "") + (b(iii, 2) = a(ii, 2)) Then
b(iii, 2) = a(ii, 2) : b(iii, myInd + 1) = b(iii, myInd + 1) + a(i, 6)
If a(i, 4) = "GK" Then
MsgBox "GK data found, put the amount"
b(iii, 9) = b(iii, 9) + a(i, 5)
'月計の式が不明
End If
Exit For
End If
Next
End If
End If
Next
End If
Next
wsSummary.Range("a40").Resize(UBound(b, 1), 9).Value = b
Set wsData = Nothing : Set wsSummary = Nothing
End Sub
(seiya)
再修正:11:38
こんにちは。かみちゃん です。
> 少々訂正してMsgBoxを追加しました
vbLf で終わっている行は、 vbLf & _ という記述が必要かと思います。
あと、 変数の宣言として、 Dim wsData As Worksheet Dim wsSummary As Worksheet もあったほうがいいと思います。
(かみちゃん) 2009/08/19 11:36
(m-o-mo）
別スレ立ったのを気づきませんでした。 あちらに移ります。 (seiya)
かみちゃん さん
ありがとうございます。取り急ぎに。 2009/08/19 11:36の指摘箇所直しました。 2009/08/19 11:28はサイドに説明します。
こんにちは。かみちゃん です。
To,seiyaさん
> 2009/08/19 11:36の指摘箇所直しました。
直っていません。 コードに直接影響ないから構わないのでしょうけど。
MsgBox CDate(b(i, 1)) & " found on row " & i + 38 & " in 予算" & vbLf
は、
MsgBox CDate(b(i, 1)) & " found on row " & i + 38 & " in 予算" & vbLf & _
^^^^^
で、
MsgBox "Person matched with " & b(i - 1, 3) & vbLf _
は、
MsgBox "Person matched with " & b(i - 1, 3) & vbLf & _
^^^
です。 あちらで提示されているコードでも同様です。
(かみちゃん) 2009/08/19 16:32
かみちゃん さん
ありがとうございます。＾＾ 自分の持っているコードは＆追加しました。
(m-o-mo)
かみちゃんさん
返信遅くて済みません。取り急ぎに。 かみちゃんさんの質問
[A] [B] [C] [D] [E] [F] [G]&[H] [40] 月 地名 伝表発行 GS KS 金額 [41] 2008/4/1 EK （m-o-mo） 215 27767 [42] DJ （m-o-mo） 215 215 55534 [43] SB （m-o-mo） 215 215 55534 [44] DJ(西) （m-o-mo） 215 215 55534 [45] TH （m-o-mo） 215 215 55534 [46] NH(大根) （m-o-mo） 215 215 55534 [47] NH(鶴巻) （m-o-mo） 215 215 55534
お手数おかけしますが、よろしくお願いします。
(かみちゃん) 2009/08/19 17:10
私の回答 にならず
[A] [B] [C] [D] [E] [F] [G]&[H] 月 地名 伝表発行 GS KS 金額 2008/4/1 EK （m-o-mo） 540.00 DJ （m-o-mo） 216.00 540.00 SB （m-o-mo） 108 162.00 DJ(西) （m-o-mo） 108.00 108.00 TH （m-o-mo） 108.00 162.00 NH(大根) （m-o-mo） 162.00 108.00 NH(鶴巻) （m-o-mo） 162.00 324.00
になります。
＞これが見てみたいです。 ＞いただいたメールアドレスに即返信しましたが、アドレスが違うのかPCもしくはドメイン拒否されているのか、エラーになりました。 ＞なお、明日以降は、頻繁に書き込みはできませんので、あしからずご容赦ください。 その際本物のデータが必要ですね＾＾；； 前公開はまずいですね。 いくつか質問があります。また明日によろしくお願いします。
(m-o-mo)
こんにちは。かみちゃん です。
To,m-o-mo さん
> 私の回答 > にならず > > [A] [B] [C] [D] [E] [F] [G]&[H] > 月 地名 伝表発行 GS KS 金額 > 2008/4/1 EK （m-o-mo） 540.00 > DJ （m-o-mo） 216.00 540.00 > SB （m-o-mo） 108 162.00 > DJ(西) （m-o-mo） 108.00 108.00 > TH （m-o-mo） 108.00 162.00 > NH(大根) （m-o-mo） 162.00 108.00 > NH(鶴巻) （m-o-mo） 162.00 324.00 > > になります。
ややこしい質問をしてしまいました。 私が申し上げたかったのは、 以下にアップさせていただいた http://kamicha1.web.fc2.com/Excel/m-o-mo20090818.html Syuukei20090819.zip を解凍していただき現れる 集計.xls に、 [[20090819104249]]『VBA で集計』（m-o-mo） でseiyaさんから 2009/8/19 16:45 ごろに提示されたtestマクロを実行していただくと、 その結果になりますか？ということでした。
担当別シートは、いただいた 集計.xls では、以下のようになっていますが、 2008/4/1 の 支店名（地名）EK の 項目 GS は 540 になりませんよね？
[A] [B] [C] [D] [E] [F] [1] 年月日 支店名 項目 人名 金額 人数 [2] H20.4 EK GS GK 136253 1055 [3] H20.4 DJ GS GK 27767 215 [4] H20.4 DJ KS GK 58363 504 [5] H20.4 SB GS GK 63541 492 [6] H20.4 SB KS GK 13548 117 [7] H20.4 DJ(西) GS GK 10461 81 [8] H20.4 DJ(西) KS GK 2316 20 [9] H20.4 TH GS GK 52564 407 [10] H20.4 TH KS GK 12853 111 [11] H20.4 NH(大根) GS GK 47786 370 [12] H20.4 NH(大根) KS GK 7758 67 [13] H20.4 NH(鶴巻) GS GK 48818 378 [14] H20.4 NH(鶴巻) KS GK 22234 192
> 検証してみました。ほしい結果はこれですが。 > > [A] [B] [C] [D] [E] [F] [G&H] > 月 地名 伝表発行 GS KS 金額 > 2008/4/1 EK （m-o-mo） 1,055.00 136,253 >
とおっしゃっているとおり、2008/4/1 の 支店名（地名）EK の 項目 GS は 1055 が正解なのですよね？ であれば、私もm-o-moさんも二次元配列のコードでは、正解を求められていないということですね？
そのようにseiyaさんにあちらで、お伝えしてみてはいかがでしょうか？ 私は、お伝えする立場にありませんし、お伝えしても聞いていただけないようですので。
いずれにしても、こちらでは、Dictionaryによるコードのスレッドにさせていただき、 二次元配列は、私も勉強させていただきたいので、あちらのスレッドで書かせていただきたいと思います。
seiyaさんも >> 混乱を避ける意味でもDictionaryを使用したコードに関しては元スレに戻った方がよい とおっしゃっていますし、 私の現在の疑問は、集計.xls が二次元配列のコードでの集計結果が正しくないことと、 Dictionaryを使ったコードで、本番データが正しく集計できないことになりますので、 前者は、あちらで、後者は、こちらでコメントさせていただきたいと思います。 ややこしいことして申し訳ありません。
(かみちゃん) 2009/08/19 18:11
返事遅くてすみません。
(かみちゃん) 2009/08/19 18:11 あまりよくわからないです。
(かみちゃん) 2009/08/20 9:30 遅くなりましたが、読ませていただきました。大体理解しました。
(かみちゃん) 2009/08/20 10:17 ？？？なんとなく理解できました。
(かみちゃん) 2009/08/20 10:31 いろいろ方法あるんですね。 数式の場合は自動記録で得た式を貼り付けるしかできなかったんです。
＞いくつか質問があります。また明日によろしくお願いします。
KSとGSとGkと漢字に変換したところ計算されないのは何故かと質問したかったのですが、
答えを見つけてしまいました。
1.Const GK As String = "ごう加藤"
^^^^^^^^^^をなしたら普通に合計できました。＾＾；；；
>vntKey(1, j) = Replace(vntKey(1, j), " （人）", "")
>vntKey(1, j) = Replace(vntKey(1, j), " （人 ） ", "")
^^^^^^^^ をとったらエラーなりますね・・・。（人）が必要なくなる 場場合はどのようにすればいいですか？
2.５月のみですが、EKだけ一番下になってしまいます。 ４月のような並び順にできませんか？ シート順に引っ張る場合は4月のレイアウトのようになります。 それは、なた控えをしたために起きた現象？ それにしても、なぜ５月のみ？ 2008/5/1 DJ SB DJ（西） TH NH（大根） NH（鶴巻） EK ←この子
2008/4/1 EK DJ SB DJ(西) TH NH(大根) NH(鶴巻)
あと5月の中に（鶴牧）を（鶴巻）に変更お願いします。 レイアウトは変わっていません。
(m-o-mo)
追伸：自問自答で解決してしまいました。 データがずれただけでした。 dt.xls 54行目EK項目の日付 2008/6/1 → 2008/5/1 変更。 (m-o-mo) 2009/8/20 15：53
流れてしまいそうなので、書いておきますが。。。
For j = 5 To lngColumnMax - 1
vntKey(1, j) = Replace(vntKey(1, j), " （人）", "")
vntKey(1, j) = Replace(vntKey(1, j), " （人 ） ", "")
Next
の作業が、不要になるんじゃないかと思います。
(HANA)
こんにちは。かみちゃん です。
To,HAHAさん
> 流れてしまいそうなので、書いておきますが。。。
次回は、水曜日というお約束なので、お待ちしている状況です。
> 作業が、不要になる
そのとおりですが、多少仕様変更があるようです。 経緯は、もうひとつのスレッドを参照してください。 もしかしたら、わけわからなくなるかもしれませんが・・・
(かみちゃん) 2009/08/24 22:56
一応、あちらのスレも見ているつもりですが？
こちらとあちらを別々にしたのは、(m-o-mo)さんです。 こちらは(m-o-mo)さんの質問で終わっていますので コメントをしました。
(m-o-mo)さんが、何処まで二つを区別して居られるのか分かりませんが 私は区別すればよいと考えます。 その為に、別スレに成っているのでしょうから。
(HANA)
こんにちは。かみちゃん です。
To,HANAさん
> こちらとあちらを別々にしたのは、(m-o-mo)さんです。 > こちらは(m-o-mo)さんの質問で終わっていますので > コメントをしました。
別にコメントしないでくださいとは言っていません。 待ってあげてください、と申し上げているつもりです。 流れることもありません。私が水曜日まで待っていますので。
> (m-o-mo)さんが、何処まで二つを区別して居られるのか分かりません
こちらは、質問のきっかけであったDictionaryによる解決方法について、 あちらは、別解として二次元配列による解決方法について というスレッドの区分けがあると思っていて、同じ題材ですが、２つの解について、質疑が進められています ので、あちらの仕様が変われば、こちらも変わると考えています。
あまり、質問者がいない状況で議論をするのは、好ましくないので、その辺お汲み取りいただければと思っています。
(かみちゃん) 2009/08/24 23:21
To,かみちゃんさん
先ほども申し上げましたが このスレ内で、(m-o-mo)さんの質問で最後に成っていたので 私はコメントを致しました。 それだけのことです。
質問者さんが、考え中だったり 待ってくださいと言っているなら 待ちますが、次のコメントまで時間が空くと言っているだけですよね？ しかも、このスレではなく 他のスレで。 ・・・なんて書いても仕方ないと思いますが・・・。 それにしても・・・以下(m-o-mo)さんへ・・・・ レスする頭は沢山有りますが、考える頭は一つしか無いので 片方が片づくまで、もう片方にはきっちり小休止宣言を なさっておいた方が良いのではないでしょうか。 （でないと、こんな事に成ります。笑） どのタイミングで口を挟もうかと思っていたのですが そうは言っても、同時進行は無理が有ると思いますよ？
(HANA)
こんにちは。かみちゃん です。
> それだけのことです。
わかりました。議論するほどのことでもないので。
> 次のコメントまで時間が空くと言っているだけですよね？ > しかも、このスレではなく 他のスレで。
留守の宣言をなさっているのは、紛れもない事実です。 別のスレッドかどうかは関係ないです。 HANAさんが何をおっしゃりたいのかは理解できませんが、説明していただかなくても構いません。
「同時進行は無理が有ると思いますよ？」とありますように、私も、これを感じ始めた ので、レスを控えて、落ち着いてから、続けようかと思っていたのですが、それであれば、 そのように提案しておけばよかったですね。
以下、m-o-moさんへ
進めかたの提案です。 あちらが落ち着いてから、ご質問の件は、回答させていだだくことではいかがでしょうか？ もちろん、HANAさんのアドバイス以外にもお伝えしたいことはありますので・・・
(かみちゃん) 2009/08/25 0:11
HANAさん
いつも丁寧なコメントをありがたく見させていただいています。
ここは、かみちゃんさんに任せておいて、HANAさんは他のスレッドのコメントに力を注いでいただければ 学校の生徒としてはうれしいです。 HANAさんのお手を煩わせるほどの問題でもないし、他の質問の回答を待っている大勢の方がいますので、 そちらに時間を割かれてはいかがでしょうか？
> 流れてしまいそうなので > こちらは(m-o-mo)さんの質問で終わっていますので
このようなことはHANAさんがしなくても、かみちゃんさんがきちんと対応してくれますよ。 あちらのスレッドも見ているなら、質問者がいらっしゃらないのは、わかっておられますよね。
HANAさんには、もっと別のスレッドで時間を割いてほしいところがあると思います。 時間が余っているなら別ですけどね。
(学校の生徒)
> HANAさんは他のスレッドのコメントに力を注いでいただければ > 学校の生徒としてはうれしいです。 誰がどの質問に回答をつけようが、 基本的には回答をつける人の自由であるはず。 「このスレでなく、あっちにレスしろ」なんて、 誰が、何の権利でもって指示できると？ （特に、まぜっ返しでもしていない限り）
質問者が、Aさんに回答して欲しい と思っても、 Aさんは、回答したくないってケースもあるでしょうし。
> 時間が余っているなら別ですけどね。 余計なお世話。
（ま、話の通じない人と関わるのは止めれば？と思う ことはありますが、それだって余計なことです）
（hashimoto）
誰が、どの様に思って どの様な行動をとっているのか 本人にしか分からないと思いますよ。
＞かみちゃんさんがきちんと対応してくれますよ。 これに関しても、過去に見落とされてたことも有りますし。 私は(m-o-mo)さんの ＞追伸：自問自答で解決してしまいました。 と、かみちゃさんのレスが無いことで 今まで こちらは一端解決した物だと思っていました。 （まぁ、関わる気があまりなかった ってのも 有るのかもしれませんが。）
かみちゃんさんが、あちらが終わるまで待っているのか 私と同じ思い違いをしているのか、見たけど忘れているのか 私に分かるはずが有りません。 それは、(m-o-mo)さんにも分からないでしょう。 (学校の生徒)さんなら、100%で言えますか？
(m-o-mo)さんが、水曜日にこのスレを見たときに 「レスが付いてないから向こうに専念出来て良かった」と思うか 「質問してるのに、レスが付いて無いなぁ。何でかなぁ」と思うか ・・・それも、(m-o-mo)さんにしか分かりません。
しかし、私は後者の可能性を考えてコメントを書きました。
答えを期待せずに質問をする人は居ないと思います。 そう考えると、次に開いた時に答えがないと。。。嬉しくは無いでしょう？ （一般論ですけどね。間違っていないと思いますよ。）
(学校の生徒)さん、ですから 今現在、質問者さんが居るか居ないかは問題では有りません。
次に、話しかけた人（質問をした人）が見たときに、 （例え親身になって受け取って居る人が居たとしても） その言葉がそのままに成っている場合と 誰か親身に受け取って、言葉を返してくれている場合と どちらが嬉しいですかね。 或いは、どちらが悲しいですかね。
私は、色々なスレに沢山コメントを書いても やはり、書いただけのコメントが返ってこないと 悲しいと思いますし、不安に思いますよ。
まぁ、実際は 気分に大いに左右されてコメントしますし 実質的な問題も有りますので なかなか実行は出来ませんけどね。
おっと、(m-o-mo)さん 長いこと場所を無断拝借して、失礼しました。
(HANA)
こんにちは。かみちゃん です。
To,m-o-moさん
質問者のm-o-moさんがいない間に、Excelに関係のない話で、スレッドがどんどん伸びてしまって申し訳ありません。 スレッドの伸びた原因のひとつは私にあるのだと思っています。
HANAさんからアドバイスがあるとおり、
> For j = 5 To lngColumnMax - 1 > vntKey(1, j) = Replace(vntKey(1, j), " （人）", "") > vntKey(1, j) = Replace(vntKey(1, j), " （人 ） ", "") > Next > > の作業が、不要になるんじゃないかと思います。
は、私も同じ考えを持っていて水曜日にコメントしようと思っていた内容ですので、 それ以降の内容は、少なくとも私のコメントはスルーしてください。
> 流れてしまいそうなので、
どうもこういう書き方をされると、「忘れているよ！」と書かれているようで過剰反応してしまったのかもしれません。
なお、もうひとつ、HANAさんが「同時進行は無理が有ると思いますよ？」とおっしゃっていとおり、 あちらが落ち着いてから、こちらのご質問の件は、続けさせていただくということでいかがですか？ まぁ、あちらの方法で解決したら、こちらは、用がなくなってしまうかもしれませんが、せっかくの機会ですから。 そのあたりの判断は、m-o-moさんにお任せしたいと思います。
(かみちゃん) 2009/08/25 6:00
Σ（＠□＠；；；；； 休んでいる間にすごい事に・・・・・・・。 何から応えたら・・・・・・（オロオロ）
たくさんのコメントありがとうございます。
For j = 5 To lngColumnMax - 1
vntKey(1, j) = Replace(vntKey(1, j), " （人）", "")
vntKey(1, j) = Replace(vntKey(1, j), " （人 ） ", "")
Next
に関して、質問当初は（人）の内容を少し変更したので上手く合計できず、消そうと思いました。
理由はわかりませんが、いろいろいじった所思い通りの結果得たので、そのまま使用しています。
レスが、付かなかったので、結果報告しませんでした。(言い訳？ ＾＾；；；
今回二つレスして良かったと思っています。いままで、わからなかったことが、わかるようになりました。 ただ質問の仕方が、不味かったんだと反省しています。 何事にもマナーは必要ですね。 （＾。＾；；；
>あちらが落ち着いてから、こちらのご質問の件は、続けさせていただくということでいかがですか？ お言葉甘いてそうさせて下さい。 今回私の行動で不快な思いをさせたことをお詫びいたします m(_ _ )m
(m-o-mo) 2009/8/26 8:30
こんにちは。かみちゃん です。
To,m-o-moさん
平日日中は、まったく時間がとれない時期になってきたので、このくらいの時間しかコメントできないのですが、
> 何から応えたら・・・・・・（オロオロ）
私の不用意な発言のおかげで、オロオロさせてしまい、申しわけありません。
> いろいろいじった所思い通りの結果得たので
あたらのスレッドを見ていても感じているのですが、 m-o-moさんのほうでいじられている内容がほとんど伝わってきていないように思います。 少なくとも、私は、ファイルを拝見できる環境を持っていますし、大抵の場合、動作確認をした上で コメントをさせていただいています。
つまり、「いろいろいじった」内容を逐次説明していただきたいと思っています。 シートのレイアウトを変えたのか、 セルの値を変えたのか、 セルの書式設定を変えたのか、 VBAのコードを変えたのか、 状況をここを見ている者も再現できるようにありのまま説明していただければいいのです。
そうでないと、状況に食い違いが発生し、いらぬやりとりが増えます。 先日は、あちらのスレッドでお二人のやりとりを見ていて、たぶん「いろいろいじった」せいであって、 いじる前の状態に戻せばいいのにと感じたやりとりがありました。 何も口出ししませんでしたが・・・
ファイルのアップが必要でしたら、また連絡していただければいいです。 ただ、連絡先のメールアドレスがエラーになるので、アップ完了のご連絡等を差し上げられない状況が起きているのですが・・・
>>あちらが落ち着いてから、こちらのご質問の件は、続けさせていただくということでいかがですか？ >お言葉甘えてそうさせて下さい。
では、あちらが解決しましたら、このコメントに続けてください。 あちらが解決するまでの間は、このコメントにお返事いただかなくても構いません。 いつまでもお待ちしていますので・・・・
では、無事解決することを祈っています。
(かみちゃん) 2009/08/26 22:33
かみちゃん さん
長々とお待たせして申し訳ありませんでした。 あとお騒せてすみませんm(_ _)m
＞つまり、「いろいろいじった」内容を逐次説明していただきたいと思っています。
＞シートのレイアウトを変えたのか、
＞セルの値を変えたのか、
＞セルの書式設定を変えたのか、
＞VBAのコードを変えたのか、
＞状況をここを見ている者も再現できるようにありのまま説明していただければいいのです。
設定されたはずの書式設定が解除されたのが、気づかなかったからです。
月 地名 伝表発行 GS（人） KS（人） 金額（円）
が↓になり 月 地名 伝表発行 GS（単位：人） KS（単位：人） 金額（単位：円）
（）内は書式設定のもだと思ったわたしは、なぜだろうともんもんし もしやと思い vntKey(1, j) = Replace(vntKey(1, j), " （人）", "") ^^^^^^^^^を（単位：人） と追加したところ無事できました。 そして、↑の大事さを気づきそのまま使わせていただいています。
結論から言いますと、ドジをした。ということです。
＞メールアドレスがエラーになるので、 今現在私はEメールアドレスは持っていますが、使えないのです。 ご存知の通りに家のほうはネット使えない状況になり。（PCが故障中） iphonのEメール設定が一切できないからです。（｀〜´＃） （会社のPCでやったんですが、制限がかかってできませんでした。（＞＜＃）） しょうがないので前のアドレスを入力しました。（使わないと思ったからです。。。。） アドレスがないと一言伝えるべきでしたね（＞＜）すみません。 >進めかたの提案です。 > あちらが落ち着いてから、ご質問の件は、回答させていだだくことではいかがでしょうか？ お気遣いありがとうございます。順序が逆になってしまいすみませんでした。
＞もちろん、HANAさんのアドバイス以外にもお伝えしたいことはありますので・・・ ＞平日日中は、まったく時間がとれない時期になってきたので、このくらいの時間しかコメントできないのですが、 の方も気になりますので、お時間があるときでかまいません。よろしくお願いします。
P.S おっとこれを忘れるとこでした。
＞できましたら、スルーしないで読んでいただければうれしいのですが、 書いていただいたコメントはちゃんと読んでいますよ〜。 ただ、私は書くのが遅いので、全部返信すると大変なことになります。 回答でいっぱいいっぱいでレスの中身がまったく分からないまま進められる事態に・・・。 なので、基本的に回答者のみ返答しています。（時間的に余裕あるときは別ですが・・・・） 申し訳ないと思いつつ、「堪忍してや〜」と心の中でつぶやいています。
> ＞次月の目標額を挿入したい。 ＞シートレイアウトに変更／追加があるのではないでしょうか？ いえ。変更も追加もありません＾＾
＞それであれば、別スレッドにしたほうがいいのでは？ ＞もちろん、質問しているm-o-moさん、アドバイスされているseiyaさんの双方のご迷惑にならないという前提ですが。 ＞スレッドを参考に勉強している者（少なくとも私は、こちらのスレッドでは、その立場にいるつもりです）にとっては、 ＞スレッドがここまで伸びてくると、わかりにくくなってきているのが事実です。 ご指摘ありがとうございます。行と列を入れ替えの箇所がありフム〜と思いつい質問してしまいました。＾＾；； ＞あと、もうひとつのDictionaryのスレッドも同じようにシートレイアウトに変更／追加が生じるのでしょうか？ そうですね。教えていただけるんでしたら、大変うれしいし勉強したいと思います。 ただ、新たに質問を立ち上げたり、かみちゃんさんが時間がないときは省いて下さい。
(m-o-mo)
2009/8/27 14:30
こんにちは。かみちゃん です。
> 教えていただけるんでしたら、大変うれしいし勉強したいと思います。
ひとつ確認したいのですが、Dictionaryの方法で今わからないところがあるなら、再度教えていただけませんか？ もし、 シートのレイアウトを変えた セルの値を変えた セルの書式設定を変えた VBAのコードを変えた があるのなら、教えてください。 私が現在把握しているのは、 http://kamicha1.web.fc2.com/Excel/m-o-mo20090818.html にアップしているファイルになります。
また、二次元配列の方法は、このファイルを使って、勉強させていただいて、期待値どおりになっていることが確認できています。
> 会社のPCでやったんですが、制限がかかってできませんでした
たまにそういう環境がありますね。 ただ、連絡先は、連絡取れるところにしておいていただけるとここまで、解決に時間がかかるような内容ではなかったかもしれません。
> 新たに質問を立ち上げたり、かみちゃんさんが時間がないときは省いて下さい。
この意味が少しわかりません。
なお、今日は、これ以上書き込みできません。次回は、明日の夜以降になります。
(かみちゃん) 2009/08/28 8:59
かみちゃん さん
お忙しい中ありがとうございます。
>シートのレイアウトを変えた 返答したとおり変更していません。なぜそう思われましたか？
>セルの値を変えた 担当別データが違った箇所のみ修正しました。 担当別 15行目 EK項目の日付 2008/6/1 → 2008/5/1 変更。
>セルの書式設定を変えた [E][F]の項目名は書式設定 ＝＠" (単位:人)" [G]は書式設定＝＠" (単位：円)"
>VBAのコードを変えた
For j = 5 To lngColumnMax - 1
vntKey(1, j) = Replace(vntKey(1, j), " （単位：人）", "")
vntKey(1, j) = Replace(vntKey(1, j), " （単位：人） ", "")
＞今日は、これ以上書き込みできません。次回は、明日の夜以降になります。 土曜の夜9時頃にコメント除いて見ます。 返答はできますが、データの実行は月曜日にさせてください。
＞二次元配列の方法は、このファイルを使って、勉強させていただいて、期待値どおりになっていることが確認できています。 ？？？はい期待通りになったため。レスは終了しました。違う意味で言っていますか？
>ひとつ確認したいのですが、Dictionaryの方法で今わからないところがあるなら、再度教えていただけませんか？ はいあります。まずは
If myVal(i, 4) = GK Then
1） myKey = myVal(i, 7) & "," & myVal(i, 2) & "," & "," & GK
If Not mydic.Exists(myKey) Then
x = x + 1
mydic.Add myKey, x
End If
2） y = mydic(myKey)
3） myVal2(y, 1) = myVal(i, 7)
4） myVal2(y, 2) = myVal(i, 2)
For j = 5 To lngColumnMax - 1
If myVal(i, 3) = vntKey(1, j) Then
myVal2(y, j - 1) = myVal2(y, j - 1) + myVal(i, 6)
myVal2(y, lngColumnMax - 1) = myVal2(y, lngColumnMax - 1) + myVal(i, 5)
1.↑は元データの読み込みということは予算シートに格納する条件設定？ 2.２）のkeyは１）条件？？ 3.３）は予算の一列目のこと？ 4.４）は項目を取得するコード？ でしょか？
(m-o-mo)
2009/8/28 17:05
こんにちは。かみちゃん です。
> 1.↑は元データの読み込みということは予算シートに格納する条件設定？ > 2.２）のkeyは１）条件？？ > 3.３）は予算の一列目のこと？ > 4.４）は項目を取得するコード？
そうです。とだけ答えておきます。
あとは、あちらで、seiyaさんが、なぜかDictionaryのコードを提示されてしまったので、 私からは、もう何も申し上げられません。（言いたいことはあるのですが、やめときます） 無責任は重々承知ですが、これ以上触れることは混乱を招くので、申し訳ありませんが、私は撤退させていただきます。
なお、サンプルシートを見てほしい事案があれば、私でよければいつでもいくらでも拝見しますので、おっしゃってください。 （今回は、サンプルファイルとコードを見れば、不具合箇所が一発でわかるような事案です。）
いろいろとご迷惑おかけしました。 こういう無責任なことをするのは、心苦しいのですが、混乱を防ぐためにも断腸の思いで撤退させていただきます。 本当に勝手で申し訳ありません。
(かみちゃん) 2009/08/29 21:02
かみちゃんさん
・・・・・・・。 今回は私のレスの仕方が悪いです。 御怒りをおさめるようお願いします。 そして撤退するのはかみちゃんさんではなく私とさせて下さい。 ながながとレスお付き合い頂き本当に有難うございました。 あとは不明なてんは自分で調べます。これも勉強です。
本当にありがとうございました。 また、なにかありましたらそのきもよろしくお願いします。
(m-o-mo) 23:53
こんにちは。かみちゃん です。
> 御怒りをおさめるようお願いします。 > そして撤退するのはかみちゃんさんではなく私とさせて下さい。
ちょっと、勘違いをされているので、一言だけ。 私は、怒っていません。 私のレスの仕方の方がいけないのだと思います。 早くm-o-moさんの解決につながるようにしてきた余計な気遣いがいけなかったのかもしれません。 私は、撤退をさせていただきますが、m-mo-moさんは、撤退する必要はありません。 あちらで回答されている方には、とことん、理解できるまで質問して、自分のモノにしていただきたいと思います。
ご迷惑おかけして申し訳ありませんでした。失礼します。
(かみちゃん) 2009/08/30 7:54
> あとは、あちらで、seiyaさんが、なぜかDictionaryのコードを提示されてしまったので、 > 私からは、もう何も申し上げられません。（言いたいことはあるのですが、やめときます）
なにか問題でもあるわけ？ 回答者自身の自己満足のみを考えて、質問者の利益に繋がることを考えていない典型としか思えない。 (seiya)
こんにちは。かみちゃん です。
> なにか問題でもあるわけ？
問題はないです。ただ、言っていることとしていることがちょっと違うかなと。 質問者の利益に繋がることを考えていないのは、そちらも多少あるかと思いますよ。 Excelの環境がないから、動作確認していないのでは？ それとも、エラー・不具合が出たら自分で考えることも、利益に繋がるというのなら、理解はできます。 至難の技ですけどね。
(かみちゃん) 2009/08/30 9:19
こんにちは。かみちゃん です。
To,m-o-moさん
撤退すると申し上げたのですが、よく考えると、私が提案したコードに対して、m-o-moさんが質問されている点に ついて、ほとんど答えれていないのかもしれませんので、反省の意味も含めて、再度書かせていただきます。
まずは、今までの書き込みを見ると、以下のようなコードに修正して、検証してみてください。 修正前後がわかるように修正前のコードをコメントアウトしています。
Sub Sample1_2() Dim WS1 As Worksheet Dim WS2 As Worksheet Dim myVal As Variant Dim myKey As String Dim mydic As Object Dim i As Long Dim j As Long Dim k As Long Dim lngColumnMax As Long Dim dblSum As Double Dim x As Long Dim y As Long Dim rngResult As Range Dim vntKey As Variant Dim c As Range Dim m As Variant
Const GK As String = "GK"
' Set WS1 = Workbooks("dt.xls").Sheets("担当別")
' Set WS2 = Workbooks("集計.xls").Sheets("予算")
Set WS1 = Sheets("担当別")
Set WS2 = Sheets("予算")
'元データを日付順に並べ替え（最後に元の順番に戻す）
' With WS1.Range("A2", WS1.Range("A" & Rows.Count).End(xlUp)).Resize(, 8)
With WS1.Range("A2", WS1.Range("A" & Rows.Count).End(xlUp)).Resize(, 6)
myVal = .Value
' For i = 1 To UBound(myVal, 1)
' myVal(i, 7) = Format(CDate(Replace(myVal(i, 1), ".", "/")), "gee.mm")
' myVal(i, 8) = i
' Next
' .Columns(7).Value = WorksheetFunction.Index(myVal, 0, 7)
' .Columns(8).Value = WorksheetFunction.Index(myVal, 0, 8)
' .Sort Key1:=.Cells(2, 7), Order1:=xlAscending, _
' Key2:=.Cells(2, 8), Order2:=xlAscending, Header:=xlYes
' myVal = .Value
' .Sort Key1:=.Cells(2, 8), Order1:=xlAscending, Header:=xlYes
' .Columns(8).Delete Shift:=xlToLeft
' .Columns(7).Delete Shift:=xlToLeft
End With
'転記先データの範囲の取得と集計キーの編集
Set rngResult = WS2.Range("A40:G149")
lngColumnMax = rngResult.Columns.Count
vntKey = rngResult.Rows(1).Value
' For j = 5 To lngColumnMax - 1
' vntKey(1, j) = Replace(vntKey(1, j), " （人）", "")
' vntKey(1, j) = Replace(vntKey(1, j), " （人 ） ", "")
' Next
'集計用配列変数の確保
ReDim myVal2(1 To rngResult.Rows.Count, 1 To rngResult.Columns.Count)
'元データの読み込み
Set mydic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(myVal, 1)
If myVal(i, 4) = GK Then
' myKey = myVal(i, 7) & "," & myVal(i, 2) & "," & "," & GK
myKey = myVal(i, 1) & "," & myVal(i, 2) & "," & "," & GK
If Not mydic.exists(myKey) Then
x = x + 1
mydic.Add myKey, x
End If
y = mydic(myKey)
' myVal2(y, 1) = myVal(i, 7)
myVal2(y, 1) = CLng(myVal(i, 1))
myVal2(y, 2) = myVal(i, 2)
For j = 5 To lngColumnMax - 1
If myVal(i, 3) = vntKey(1, j) Then
myVal2(y, j - 1) = myVal2(y, j - 1) + myVal(i, 6)
myVal2(y, lngColumnMax - 1) = myVal2(y, lngColumnMax - 1) + myVal(i, 5)
End If
Next
End If
Next
With rngResult
'転記先配列を確保
myVal = .Resize(, .Columns.Count - 1).Offset(, 1).Value
For Each c In .Columns(1).SpecialCells(xlCellTypeFormulas, 1)
If IsDate(c.Value) Then
' '前回の集計済みデータの消去
' c.Resize(8).Offset(, 1).ClearContents
' On Error Resume Next
' c.Resize(8).EntireRow.SpecialCells(xlCellTypeConstants, 1).ClearContents
' On Error GoTo 0
'集計結果を転記先配列に格納
' m = Application.Match(Format(c.Value, "gee.mm"), WorksheetFunction.Index(myVal2, 0, 1), 0)
m = Application.Match(CLng(c.Value), WorksheetFunction.Index(myVal2, 0, 1), 0)
If IsNumeric(m) Then
k = c.Row - rngResult.Rows(1).Row + 1
dblSum = 0
For i = 1 To 7
myVal(k + i - 1, 1) = myVal2(m + i - 1, 2)
For j = 5 To lngColumnMax
myVal(k + i - 1, j - 1) = myVal2(m + i - 1, j - 1)
Next
dblSum = dblSum + myVal(k + i - 1, lngColumnMax - 1)
Next
myVal(k + i - 1, 4) = dblSum
End If
End If
Next
'転記先へ出力
.Resize(, .Columns.Count - 1).Offset(, 1).Value = myVal
End With
Set mydic = Nothing MsgBox "集計が完了しました" End Sub
今回提案させていただいたコードに修正したファイルを以下にアップさせていただきます。 http://kamicha1.web.fc2.com/Excel/m-o-mo20090818.html Syuukei20090830.zip をダウンロードしていただき解凍していただくと、集計.xls が現れます。 （便宜上、同一ブックにシートをまとめてあり、予算シートにボタンを付けています。）
m-o-moさんのお手持ちのファイルでうまくいかない場合は、このファイルで検証してみてください。 動作確認・期待値検証していますので、このファイルでうまくいく場合は、何かが違うのだと思います。
(かみちゃん) 2009/08/30 23:14
こんにちは。かみちゃん です。
To,m-o-moさん
> m-o-moさんが質問されている点について、ほとんど答えれていないのかもしれません
少し補足させていただきます。 2009/08/30 23:14 に提示させていただいたコードは、集計.xlsを見ると、必要のないコードなどがありましたので、 余計な処理は、見直しています。 そのため、申し訳ありませんが、私から提案したコードは、こちらで、内容を検証していただいて、 こちらのコードで不明な点などあれば、ご質問いただければと思います。
もう少し早い段階でこれを提示すればよかったかもしれません。混乱させるようなことで申し訳ありません。 時間はいつまでもお待ちしますので、落ち着いてゆっくり理解を進めていただければと思います。
(かみちゃん) 2009/08/31 6:57
かみちゃん さん
すみません＞＜終わったものだとばかり。。。 その節はご迷惑をおかけすみませんでした。 返信遅くなりすみません。(約一ヶ月。。。）
教えていただいたコードはエラーなく大活躍中です。 上司から好評で私も鼻が高い（笑） あれから勉強し要約大まかに理解できました。 配列はまだ難しいですが、Dictionaryで集計表を作成することができました。 （ヘボチョコですが（汗）もちろん複雑な条件も抜きで。。。。）
また、躓いたときに質問に来たいと思います。 そのときも声をかけていただけますと大変うれしいです。
本当にありがとうございました。感謝でいっぱいです。
(m-o-mo) 2009/9/25
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.