| |
▼ひかる さん：
>▼kanabun さん：
>ご指摘いただきました解説をじっくりとみさせていただきました。
>最初よりだいぶ理解できたと思います。
>それで、この関連で最後の質問をさせてください。
>前のデータより次の表をうめる便利な方法があればお教えください。
あの、その方法を習得してもらうために、これまで長々とTry1()の解説
をして来たつもりなのですが？
ぼくは前々回のレスで、
> いちど、ひかるさんご自身で、ぼくがTry1()に対して行ったような解析
> （コードのトレース）を日本語で行ってみて、コードの各行が何をして
> いるものなのか、何をするためにこの一行があるのか、コメントをつけて
> 見てください。
と発言しました。
それに対して、ひかるさんは
> ▼kanabun さん：
> お返事ありがとうございます。
> 解析（コードのトレース）を日本語で行ってみて、コメントをつけてみます。
> また、コメントをつけたものをだしてみますので、添削のほど
> よろしくお願いします。
とおっしゃっていますから、ぼくはどのようなコメント付きコードが
出てくるか、楽しみにしていたのですよ。
◆要望 シート構成に 合わせて Try1() 〜 Try4() と同様のコードが
空で（サンプルコードを見ないで）書けるようになるまで、
反復練習してみてください。
もちろん、コードの意味が分からない部分があれば、時間のあるときに
お答えしますよ
>それで、この関連で最後の質問をさせてください。
別に期限があるわけではないので、閉じ急ぐ必要はさらさらないですよ。
Try1()〜 Try4() までの サンプルコードが理解でき、
ご自分で、↓のようなレイアウトのばあいに、それらを応用したコードが
試行錯誤しながらでも、書けるようになったときが、このスレッドを
終了するときです。
> 集計表 単位：円
> A B C D E ........... K
> 1 4月 5月 6月 ...........12月
> 2 大人 男
> 3 女
> 4 小人 男
> 5 女
'主に Sub Try4()を参考にして、上の集計表に合うように修正
していきます
'下に、サンプルコードを示します。
現在の Sub Try5()をコピーしてモジュールに
貼り付けると、たくさん 赤字になります。
から、コメントにガイダンスがあるように
空白部を実際のコードで埋めていってください。
'--------------------------------------------------
Option Explicit 'モジュールの先頭に宣言する（変数は必ず _
宣言して使うため ）
Sub Try5() '集計先のシートをアクティブにして実行
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim dic As Object
Dim r As Range, c As Range
Dim tbl
Dim i As Long, ss As String
Dim strFirst As String '変数strRoomを変更
'（集計シートのA列：大人／小人）
Dim strSecond As String '集計シートのB列：男／女
'抽出元の表のあるシートを変数WS1 にセットしてください
Set WS1 = Worksheets(" ")
Set WS2 = ActiveSheet 'アクティブシート（集計表）
'集計表シートがアクティブになっているか、確認する
If WS2.Name = WS1.Name Then
MsgBox "集計用シートをアクティブにして実行すること"
Exit Sub '中断
End If
'◆これより 集計表のレイアウトの取得
'書きこみ先（集計表）表範囲を変数r にセットしてください
Set r = WS2. '書きこみ先表範囲
Set r = Intersect( , ) 'そのうち、正味データ部を _
変数r に再代入してください
'↑◆ヒント 上のような集計表構成では _
[A1].CurrentRegion により変数rrに表全体範囲が _
入っていますから、その範囲と、 _
その範囲を1行下に、2列右にシフトした範囲 _
とが重なる範囲を Intersectメソッドで取得すれば _
いいです
r.clearcontents '行列見出しを除く正味データ部をクリア
tbl = r. 'クリア後の範囲を配列に格納してください
'↑◆ヒント RangeオブジェクトのValueプロパティ
'---- 集計テーブルの情報を Dictionary に格納 -----
'↓Dictionaryオブジェクトのインストール
←
'A列見出しと B列見出しを結合して 行位置（行index）を辞書に格納
For Each c In r.Resize(, 1).Offset(, -1) 'B列見出し項目でLoop
i = i + 1
If Len(c(1, 0).Text) Then strFirst = c(1, 0).Text 'A列文字列
dic(strFirst & c.Text) = i
'この処理で dic("大人男") に（行番号） 1 が、 _
dic("大人女") に（行番号） 2 が、 _
dic("小人女") に（行番号） 3 が、 _
dic("小人女") に（行番号） 4 が格納されます
Next
Stop
'上のLoopが終わったあと 変数strFirstには「小人」が格納されて _
います。Stopはプログラムの実行を中断するための命令です。 _
Stopしたら、メニュ−［表示］−［ローカルウィンドウ]で
ローカルウィンドウをのぞいて 変数の内容を確かめてください。
'次に ---------------------------------------------------
'1行目見出し項目（◆年月）情報をdicに記憶しておきます
'この部分は Try4()がそのまま使えると思います。
←
'--------------------------------------------------------
'↓変数strSecond に集計表B列の見出し項目を記憶
strSecond = WS2.range("B2").Value 'この例では「男」が代入 _
されます。ステップ実行[F8]してこの行を実行したら _
マウスを変数strSecond に近づけて 確認してください
'---- 元表のA列×1行目の見出しに対応する 書きこみ先の _
配列tblの 行列番号を Dictionaryから得る -----
Dim rr As Range, cc As Range
Dim MonData, dat
Dim FirstData 'B列またはC列格納用変数
Dim SecondData 'B列またはC列格納用変数
Dim j As Long, n As Long, m As Long
Dim x As Long '◆見出し列位置（B列／C列）
'◆ここからが データ元表より抽出する部分です
With WS1
.Activate 'デバッグ用
Set rr = '変数rr に表範囲をセットする
End With
'例によって 元表の数値データ部分をとりだし、 _
変数rr に再セットしてください
Set rr = Intersect(rr, )
'◆ヒント 下のような元表構成では 表全体範囲rr と その範囲を _
1行下に、3列右にシフトした範囲 とが重なる範囲です
>>> A B C D E F G
>>>----------------------------------------------------------------------
>>>1 日付 利用者 性別 会議室 研修室 和室 調理室
>>>2 4月15日 大人 男 560 800 1000 500
>>>3 4月19日 小人 女 1500 600 5200 1500
>>>4 5月21日 大人 女 800 2000 800 2100
>>>5 5月31日 小人 女 5000 480 2500 600
>>>6 6月13日 小人 男 4500 3600 4800 1600
>>>7 6月18日 大人 女 100 3600 8400 2650
>>>8 6月21日 大人 男 7000 600 8000 7900
'配列変数に A列日付データを格納してください
MonData = rr. 'A列
'次に 元表のA,B列範囲から strFirst（具体的には「小人」）が _
元表のどこにあるか調べます
Set cc = rr.Offset(, -2).Resize(, 2)
Set c = cc.Find(strFirst, , xlValues, xlWhole)
If c Is Nothing Then
MsgBox "第1項目の列取得に失敗しました" & vbCr _
& " 元データシートの B,C列に <" & strSecond & _
"> が見つかりませんでした"
Exit Sub
Else
x = c.Column - 1
MsgBox cc.Item(0, x).Value _
& " の列を集計に使います"
'見つかった列のデータを配列変数FirstData に格納します。
'そのまま2次元配列(行, 列)として格納してもいいのですが、 _
簡単のためTransposeで縦に並んだデータをよこにすると、 _
一次元配列になります
FirstData = Application.Transpose(cc.Columns(x))
End If
Set c = cc.Find(strSecond, , xlValues, xlWhole)
If c Is Nothing Then
MsgBox "第2項目の列取得に失敗しました" & vbCr _
& " 元データシートの B,C列に <" & strSecond & _
"> が見つかりませんでした"
Exit Sub
Else
x = c.Column - 1
MsgBox cc.Item(0, x).Value _
& " の列を集計に使います"
SecondData = Application.Transpose(cc.Columns(x))
End If
For i = 1 To UBound(MonData, 1) '日付のレコード順に
dat = MonData(i, 1)
If IsDate(dat) Then
ss = Format$(dat, "yyyy/mm") '年月日を 年月に直す
If dic.Exists(ss) Then
m = dic(ss) '書きこみ先は 何列目か ？
ss = FirstData(i) & SecondData(i)
If dic.Exists(ss) Then
n = dic(ss) '書きこみ先は 何行目か ？
'↑ここまでは Try4()と同じです
'↓集計のしかたが変わりました。 _
これまでは一つのセルデータを集計先に累加 _
していましたが、今回は i行のデータはすべて _
SUM して、対象要素位置(n,m) に渡します。
'------tblのn行,m列目の要素に 数量を累加 -----
With Application
tbl(n, m) = tbl(n, m) _
+ .Sum(.Index(rr.Rows(i).Value, 0))
End With
End If
End If
End If
Next
'---- 配列に集計した結果を表に書き出す ------
r.Value = tbl
WS2.Activate
MsgBox "集計が終わりました"
End Sub
◆コードの穴埋めがおわりましたら、ここに報告してくださいね
|
|
kanabun
- 09/1/26(月) 14:39 -
