Excel VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちら をご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


26343 / 76738 ←次へ | 前へ→

【55726】Re:シート間のデータ検索
発言  kanabun  - 08/5/17(土) 1:18 -

引用なし
パスワード
   シートのレイアウトがこんな風だったとしますと、

<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) (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

0 hits

【55697】シート間のデータ検索 T-k 08/5/16(金) 0:39 質問
【55701】Re:シート間のデータ検索 kanabun 08/5/16(金) 10:18 発言
【55702】Re:シート間のデータ検索 kanabun 08/5/16(金) 10:22 発言
【55708】Re:シート間のデータ検索 T−K 08/5/16(金) 11:50 質問
【55711】Re:シート間のデータ検索 kanabun 08/5/16(金) 14:04 発言
【55724】Re:シート間のデータ検索 T-k 08/5/16(金) 23:51 質問
【55725】Re:シート間のデータ検索 kanabun 08/5/17(土) 0:23 発言
【55726】Re:シート間のデータ検索 kanabun 08/5/17(土) 1:18 発言
【55765】Re:シート間のデータ検索 T-k 08/5/18(日) 23:16 質問
【55767】Re:シート間のデータ検索 kanabun 08/5/19(月) 1:03 回答
【55797】Re:シート間のデータ検索 T-k 08/5/19(月) 23:26 お礼

26343 / 76738 ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free