| |
▼kanabun さん：
大変申し訳ありませんでした。
自分で考えず、kanabunさんにたよりすぎました。申し訳ございません。
にもかかわらず、穴埋め問題で助け舟まで出していただき言葉もありません。ありがとうございます。
それで、とりあえず穴は埋めさせていただきました。
これで実行して、結果も得られました。ありがとうございました。
それで、コードの中で質問なのですが、
1点目は、集計テーブルのA列とB列見出しの結合のところですが、
If Len(c(1,0).text) then ・・・・のc(1,0)なのですが、私は、この場合男の横が大人だと思ったのでc(0,-1)と思ったのですが、どうしてこうなるのでしょうか。
2点目は、配列変数に A列日付データを格納するところですが、
MonData = rr.rr.Offset(, -3).Resize(, 1).Valueの.Resize(,1)なのですが、Resize(,1)の1は、なぜ1なのですか。ほしいのはMonDataだから、日付の入っている分が重要でこれにはあまり意味がないということでしょうか。
つまらない質問でもうしわけございませんがお教えください。
よろしくお願いします。
>'--------------------------------------------------
>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("◆sheet1")
> Set WS2 = ActiveSheet 'アクティブシート（集計表）
> '集計表シートがアクティブになっているか、確認する
> If WS2.Name = WS1.Name Then
> MsgBox "集計用シートをアクティブにして実行すること"
> Exit Sub '中断
> End If
>
>'◆これより 集計表のレイアウトの取得
> '書きこみ先（集計表）表範囲を変数r にセットしてください
> Set r = WS2. '書きこみ先表範囲
> Set r = Intersect(r,r.Offset(1, 2)) 'そのうち、正味データ部を _
> 変数r に再代入してください
> '↑◆ヒント 上のような集計表構成では _
> [A1].CurrentRegion により変数rrに表全体範囲が _
> 入っていますから、その範囲と、 _
> その範囲を1行下に、2列右にシフトした範囲 _
> とが重なる範囲を Intersectメソッドで取得すれば _
> いいです
>
> r.clearcontents '行列見出しを除く正味データ部をクリア
> tbl = r.value 'クリア後の範囲を配列に格納してください
> '↑◆ヒント RangeオブジェクトのValueプロパティ
>
> '---- 集計テーブルの情報を Dictionary に格納 -----
> '↓Dictionaryオブジェクトのインストール
> Set dic = CreateObject("Scripting.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()がそのまま使えると思います。
> i = 0
For Each c In r.Resize(1).Offset(-1) '1行目見出し項目（◆年月）
ss = Format$(c.Value, "yyyy/mm")
i = i + 1
dic(ss) = i
Next ←
> '--------------------------------------------------------
> '↓変数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 = .Range("A1").CurrentRegion '変数rr に表範囲をセットする
> End With
> '例によって 元表の数値データ部分をとりだし、 _
> 変数rr に再セットしてください
> Set rr = Intersect(rr, rr.Offset(1, 3))
> '◆ヒント 下のような元表構成では 表全体範囲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.rr.Offset(, -3).Resize(, 1).Value '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
|
|
ひかる
- 09/1/27(火) 12:42 -
