第28回目 大きな表の一部抜粋

○第28回目　大きな表の一部抜粋

　大きな表の一部抜粋して説明用に表を作るという時があります。
　このテーマを考えて見ます。
　一部抜粋という意味ですが、これは、一部の列及び行のみについて対象とした表を作るということです。
　縦に年度が展開されていて、横に諸々の項目が展開されているの表を思い浮かべてください。この例で話をしていきます。
　テーマを言い換えれば、毎年度はうるさいので、五年ごとの表とする。また、横項目も全部はうるさいので概略がわかる程度の項目のみとする、説明用の表を作る、ということになります。
　必要な年度と、項目をどう与えますか？…
　必要な年度の一覧と横項目を表す列の対応表となるでしょうか。
　横項目の見出しは、元の項目のものをそのままとしましょうか。
　すると、横見出しの入っている行数の範囲が必要となります。
　横見出し作りとデータ部作りとなりますが、
　単純に
　 Cells(移動先の座標) = Cells(元の座標)
　の繰り返しということになります。
　元の表の内容が変わった場合のことを考えて、式で与えてみましょうか。
　すると、
　 Cells(移動先の座標).Formula = "元の座標"
　となります。
　更に変化技をつけて、違うシートから持ってくるというのはどうでしょうか。
　すると、元データのあるシート名が必要となります。
　
　入力データを、まとめて見ますと
　1.元データのあるシート名
　2.元データの表の横項目見出しの範囲(行数のみ)
　3.概略表を作るシートの指定
　4.元データの表のうち必要とする縦項目の内容(行数はイメージがつきづらいので実際の年度で与える)
　5.元データの表のうち必要とする横項目の列と新しい表の列との対応。
　4及び5は、新しい表を作るシートの一部に作っておくことになります。
　
　面倒を省くため、一番、二番は自動的に行ないます。ですから、元表のあるシートで、二番の範囲を指定した後、マクロを動かしてください。
　二番の指定は、行数のみが必要なので一列だけで結構です。

　軌道修正したので、これまでのことを整理しますと、
　新しいシートには、三番目と四番目をセットしておいて、元表のあるシートで二番の指定をして、マクロを動かす、ということになります。
　また、その後の処理は、概略表を作るシート(元表と同じシートでも可能とします)を指定し、その中の三、四番目がセットされている範囲を指定することになります。


Sub a15詳細な表の概略版を作る()
'元表のあるシートで、横見出しの範囲を設定してから実行。行数のみ必要なので一列でよい。
Dim セル範囲 As Range
Dim CCC As Object

'シート数、元表のシート名、シート番号、セルの範囲を取得
sh01_name = ActiveSheet.Name
ii_max = ActiveWorkbook.Worksheets.Count
ii0 = ActiveSheet.Index
rrcc1 = Selection.Address

'横見出しの行を取得
　p1 = InStr(rrcc1, ":")
　rrcc11 = Left(rrcc1, p1 - 1)
rrcc19 = Mid(rrcc1, p1 + 1)
gyo_m_1 = Range(rrcc11).Row
gyo_m_9 = Range(rrcc19).Row
gyo_m_cnt = gyo_m_9 - gyo_m_1 + 1

'シートの移動。同じシートに作りたい場合は、0を入力する
Do
flag = 0
sh_suu = InputBox("新しいシートの場所を入れてください。… -1 , 0 , 1 …など", xpos:=2000, ypos:=3000)

'シートオーバーなどの場合の歯止め＝⇒再入力
If ii0 + sh_suu > ii_max Then flag = 1
If ii0 + sh_suu < flag =" 1"> 0

Sheets(ii0 + sh_suu).Select

'設定値の取得
Set セル範囲 = Application.InputBox(Prompt:="設定値のあるセル範囲を選択してください", Type:=8)
rrcc2 = セル範囲.Address
sh09_name = ActiveSheet.Name

'これまでの処理の確認
MsgBox ("範囲は　" & rrcc1 & " --- " & rrcc2)
MsgBox ("シート名は　" & sh01_name & " --- " & sh09_name)

'設定値の取得と分析

End Sub


『'設定値の取得と分析』以降は次以降にします。