| |
▼コロネ さん：
シートの値クリアのことばかり考えてましたが、本題の表の
「統合」については
かみちゃんさんが触れられている「連想配列」をつかうと
レコードの順番が整列してなくても統合することができます。
VBAでは連想配列はVBSのDictionaryオブジェクトを使います。
外部モジュールなので、最初に
VBEメニュ−の[ツール]-[参照設定]のリストから
Microsoft Scripting Runtime にチェックを入れておいてください
Sub Try1()
Dim i As Long
Dim r As Range
Dim v As Variant
Dim n1 As Long, n2 As Long
Dim n As Long, m As Long
Dim dic1 As Dictionary
Dim dic2 As Dictionary
Set dic1 = New Dictionary
Set dic2 = New Dictionary
Set r = Worksheets(1).[A1].CurrentRegion '---(1)
v = Intersect(r, r.Offset(1)).Value '---(2)
For i = 1 To UBound(v)
If Not dic1.Exists(v(i, 1)) Then '---(3)
n1 = n1 + 1
dic1(v(i, 1)) = n1
End If
If Not dic2.Exists(v(i, 3)) Then '---(4)
n2 = n2 + 1
dic2(v(i, 3)) = n2
End If
Next
ReDim tbl(dic1.Count, dic2.Count + 1) '---(5)
For i = 1 To dic1.Count '---(6)
tbl(i, 0) = dic1.Keys()(i - 1)
tbl(i, 1) = "計"
Next
For i = 1 To dic2.Count '---(7)
tbl(0, i + 1) = dic2.Keys()(i - 1)
Next
For i = 1 To UBound(v) '---(8)
n = dic1(v(i, 1))
m = dic2(v(i, 3)) + 1
tbl(n, m) = tbl(n, m) + v(i, 4)
Next
Set dic1 = Nothing '---(9)
Set dic2 = Nothing
With Worksheets(2) '---(10)
.UsedRange.ClearContents
.[A1].Resize(UBound(tbl) + 1, _
UBound(tbl, 2) + 1).Value = tbl
End With
End Sub
'---(1) シート1の表領域を変数r に代入します
'---(2) 表領域から一行目を削除したセル範囲の「値」を
変数v （配列）にコピーします
'---(3) 辞書dic1を使い、一意な「大分類」項目名を取得
'---(4) 辞書dic2を使い、一意な「小分類」項目名を取得
'---(5) 出力用配列tblを準備します (行：大分類、列：小分類項目数+1)
'---(6) tblに 行見出しを書き込みます
'---(7) tblに 列見出しを書き込みます
'---(8) 元表(配列v)の各行の「値」を tbl配列の n行、m列
の要素位置に加算していきます。
dic1("あああ") と問い合わせると n = 1 が得られます
dic2("ＸＸＸ") + 1 と問い合わせると m = 2 が得られます
'---(9) 使った辞書への参照を解除します
'---(10)最後に 集計の終わった出力用配列を
シートの所定位置に貼り付けます
|
|
kanabun
- 10/9/24(金) 9:30 -
