| |
▼ひかる さん：
>今度は、もう少し突っ込んでやってみたいのですが、別シートに次の表が用意してあり、先ほど記述したデータから、マクロ実行後、データを記述するには、VBAコードでは、どうすればよいでしょうか。
> A B C D
>1 4月 5月 6月
>2 会議室
>3 研修室
>4 和室
>5 調理室
こんなの↓ [F8]でステップ実行して確かめてください。
元の表は Sheet1 にあり、集計表は Sheet2 にあるものと仮定しています。
'--------------------------------- 標準モジュール
Option Explicit
'dictionary編
Sub Try1()
Dim dic As Object
Dim r As Range, c As Range
Dim tbl
Dim i As Long
'---- 書き出し先のテーブル情報をDictionaryに格納 -----
Set dic = CreateObject("Scripting.Dictionary")
With Worksheets("Sheet2")
Set r = .Range("A1").CurrentRegion '書きこみ先表範囲
End With
Set r = Intersect(r, r.Offset(1, 1)) 'そのうち、正味データ部
r.ClearContents '行列見出しを除く正味データ部をクリア
tbl = r.Value 'クリア後の範囲を配列に格納
'行列見出し位置を辞書に格納
For Each c In r.Resize(, 1).Offset(, -1) 'A列見出し項目（室）
i = i + 1
dic(c.Text) = i
Next
i = 0
For Each c In r.Resize(1).Offset(-1) '1行目見出し項目（月）
i = i + 1
dic(c.Text) = i
Next
'---- 元表のA列×1行目の見出しに対応する 書きこみ先の _
配列tblの 行列番号を Dictionaryから得る -----
Dim rr As Range
Dim MonData, RoomData, dat, ss As String
Dim j As Long, n As Long, m As Long
Set rr = Worksheets("Sheet1").Range("A1").CurrentRegion.Resize(, 5)
Set rr = Intersect(rr, rr.Offset(1, 1))
MonData = rr.Resize(, 1).Offset(, -1).Value
RoomData = rr.Resize(1).Offset(-1).Value
For i = 1 To UBound(MonData, 1)
dat = MonData(i, 1)
If IsDate(dat) Then
ss = Month(dat) & "月"
If dic.Exists(ss) Then
m = dic(ss) '何列目か
For j = 1 To UBound(RoomData, 2)
ss = RoomData(1, j)
If dic.Exists(ss) Then
n = dic(ss) '何行目か
'------tblのn行,m列目の要素に 数量を累加 -----
tbl(n, m) = tbl(n, m) + rr(i, j).Value
End If
Next
End If
End If
Next
'---- 配列に集計した結果を表に書き出す ------
r.Value = tbl
End Sub
>さらに、最終行に合計をいれるとするとどうなるでしょうか。
それは ご自分で表の下に =SUM式 を入れる操作をマクロ記録すれば
得られます。
|
|
kanabun
- 09/1/14(水) 0:09 -
