| |
シートのレイアウトがこんな風だったとしますと、
＜Sheet1＞
----------------------------------------------------------------
A B C D E F G H … AV
1 品名／日付 5/15 5/16 5/17 5/18 5/19 5/20 5/21 … 6/30
2 A品名
3 B品名
4 C品名
＜Sheet2＞
-------------------------------
A B C
1 品名 日付 数量
2 A品名 5月15日 100
3 A品名 5月18日 200
4 A品名 5月30日 500
5 B品名 5月15日 100
先に説明した概略手順に対応するコードはこんな風です。
（エラー処理とかやってません）
Sub Try1()
>'＜シート１＞
>'(1) 書き込みたい正味範囲だけの配列を用意します。
>' 図の ↓部分(行番号, 列番号)
>' ┌-----------------------------
>' | (1,1) (1,2) (1,3) (1,4)
>' | (2,1) (2,2) (2,3) (2,4)
>' | (3,1) (3,2) (3,3) (3,4)
>' |
Dim arry
Dim 品名 As Range
Dim 日付 As Range
Dim 行数 As Long, 列数 As Long
With Sheets("Sheet1")
Set 品名 = .Range("A2", .Range("A65536").End(xlUp))
Set 日付 = .Range("B1", .Range("IV1").End(xlToLeft))
End With
行数 = 品名.Rows.Count
列数 = 日付.Columns.Count
ReDim arry(1 To 行数, 1 To 列数)
>'(2)品名と行番号の対応表を用意します。
>' 「A品名」といったら、行番号1 が、
>' 「B品名」で問い合わせたら、行番号2が返るようなシステムです。
>' ・・・
>' これには Dictionary オブジェクトを使います。
>' dic("A品名") = 1
>' dic("B品名") = 2
>' dic("C品名") = 3
>' と､
>' 品名をキーに､行番号をアイテムとして辞書に記憶しておくと､
>' 毎回A列を検索しなくても､ある品名に対応する行番号が
>' 行番号 = dic(品名)
>' のようにたちどころに得られます｡
Dim 品名List, Ls
Dim dic As Object
Dim i As Long
品名List = 品名.Value
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(品名List)
dic(品名List(i, 1)) = i
Next
>'(3)同様に、日付から列番号が返るような式を用意します。
>' 上の例ですと, 5/15 が 1列目なので、
>' ある日付の列番号 は (ある日付 - 5/14シリアル値) という式
>' でもいちおう列番号が得られそうです｡
>'
Dim date0 As Long
date0 = 日付.Item(1).Value2 - 1 'つまり 5/14のシリアル値
>'(4)
>' (1)の配列と (2)(3) を予備調査したら、
>' データベースを上から順に読んでいき､
>' 行番号 = dic("A品名")
>' 列番号 = #5/1/2008# - #5/14/2008#
>' 配列(行番号, 列番号) = 100
>'のように 順に配列内の適切な位置に データを代入していき、
>'
Dim data
Dim y As Long, x As Long
With Sheets("Sheet2")
data = .Range("A2", .Range("A65536").End(xlUp)).Resize(, 3).Value
End With
For i = 1 To UBound(data)
y = dic(data(i, 1))
x = CLng(data(i, 2)) - date0
arry(y, x) = data(i, 3)
Next
>'(5)最後に シートの[B3]セル以降に 配列を貼り付けます。
Sheets("Sheet1").Range("B2").Resize(行数, 列数).Value = arry
Set dic = Nothing
End Sub
|
|
kanabun
- 08/5/17(土) 1:18 -
