【他のレンジ/シート/ブックを更新する】
2 あるシートから別シートを更新
3 逆Ｚ式並びで更新
4 セルで指定したシートを更新
5 複数シートを連続更新
6 Subプロシージャの定義と呼び出し
7 あるブックから別ブックを更新
8 他のブックをオープン・クローズ
複数シートを連続更新
今回は、Excel VBA/マクロによって、あるシートからデータを読みとり
二つの別シートへデータを連続して書きこんでみます。
前回は、『漢字入力帳』シートからデータを読みとり、『漢字学習帳A』シート、
または、『漢字学習帳B』シートへデータを書きこんでみました。
今回は、『漢字入力帳』シートからデータを読みとり、『漢字問題集』シート、
及び、『漢字解答集』シートへデータを書きこんでみます。
『漢字問題集』シートは出題漢字を空欄にして、
『漢字解答集』シートは出題漢字を消さずにそのまま残します。
そこで、その準備として、Excelマクロ有効ブック内に、
『漢字入力帳』シートと『漢字問題集』・『漢字解答集』シートを作成しておきましょう。
前回使用したExcelマクロ有効ブックをコピーして『9_他の複数シートを更新2.xlsm』を作成します。
『漢字入力帳』シート
今回は、『漢字入力帳』シートからデータを読みとり、
一つ目に『漢字問題集』シート、二つ目に『漢字解答集』シートを作成してみます。
マクロ『シートから複数シート1』を、マクロ『シートから複数シート2』に名前を変えます。
宣言部を改修します。
定数『WstMD』に『漢字問題集』を代入
定数『WstKT』に『漢字解答集』を代入
Const WstMD = "漢字問題集"
Const WstKT = "漢字解答集"
処理部を改修します。
一つ目に、『漢字問題集』を作成します。
書込ワークシート『Wst』に定数『WSheetMD』つまり『漢字問題集』を格納します。
Wst = Worksheets(Est).Cells(読取行, 書込ワークシート列).Value をコメントアウトし
Wst = WSheetMD を追加します。
出題漢字の空白化の箇所をしっかりと残しておきます。
Worksheets(Wst).Range(枠領域).value = ""
二つ目に、一つ目の『漢字問題集』の作成をコピーし、『漢字解答集』を作成するように書き換えます。
書込ワークシート『Wst』に定数『WSheetKT』つまり『漢字解答集』を格納します。
Wst = Worksheets(Est).Cells(読取行, 書込ワークシート列).Value をコメントアウトし
Wst = WSheetKT を追加します。
出題漢字の空白化の箇所をコメントアウトします。
' Worksheets(Wst).Range(枠領域).value = ""
コメントアウトとは、特定の箇所をコメント化してコードを無効にすることです。
Excel VBA/マクロでは、『'』をコードの先頭につけることで、そのコードをコメントにすることができます。
コメントアウトは、一時的に除外するが、後で復活させるかもしれない内容を消さずに
そのまま残しておきたいときに便利な技術です。
【マクロ『シートから複数シート2』】
Sub シートから複数シート2()
Const Est = "漢字入力帳"
Const WSheetMD = "漢字問題集"
Const WSheetKT = "漢字解答集"
Const 読取問題番号列 = "A"
Const 読取列 = "B"
Const 最大枠数 = 4
Const 漢字最小列 = 3
Const 漢字最大列 = 6
' Const 書込ワークシート列 = "K"
Const 読取最小行 = 2
Const 最大列 = 10
Const 書込列数 = 5
Const 書込ステップ列 = -2
Const 書込問題番号最小行 = 1
Const 書込ステップ行 = 15
Dim Wst As String
Dim 読取最大行 As Long
Dim 読取行 As Long
Dim 行番号 As Long
Dim txt As String
Dim 最大文字数 As Integer
Dim 文字位置 As Integer
Dim 漢字列 As Integer
Dim 漢字名 As String
Dim 列英字名 As String
Dim 枠領域 As String
Dim ふりがな読取列 As Integer
Dim ふりがな列 As Integer
Dim ふりがな名 As String
Dim 列番号 As Integer
Dim 問題番号 As Long
Dim 書込問題番号行 As Long
Dim 最小行 As Long
'◆◆◆◆◆◆◆◆◆◆◆◆◆◆ 漢字問題集 ◆◆◆◆◆◆◆◆◆◆◆◆◆◆
Wst = WSheetMD
読取最大行 = Worksheets(Est).Cells(Rows.Count, "B").End(xlUp).Row
' ===== 読取行のｶｳﾝﾄｱｯﾌﾟS =====
For 読取行 = 読取最小行 To 読取最大行
問題番号 = Worksheets(Est).Cells(読取行, 読取問題番号列).Value
書込問題番号行 = Int((問題番号 - 1) / 書込列数) * 書込ステップ行 _
+ 書込問題番号最小行
最小行 = 書込問題番号行 + 1
列番号 = 最大列 + ((問題番号 - 1) Mod 書込列数) * 書込ステップ列
' Wst = Worksheets(Est).Cells(読取行, 書込ワークシート列).Value
列英字名 = Replace(Worksheets(Wst).Cells(1, 列番号) _
.Address(False, False), "1", "")
枠領域 = 列英字名 & 書込問題番号行
Worksheets(Wst).Range(枠領域).Value = 問題番号
Worksheets(Wst).Range(枠領域).Font.Size = 10
txt = Worksheets(Est).Cells(読取行, 読取列).Value
最大文字数 = Len(txt)
' ===== 対象文字列文字位置のｶｳﾝﾄｱｯﾌﾟS =====
For 文字位置 = 1 To 最大文字数
行番号 ＝ 最小行 + 文字位置 - 1
Worksheets(Wst).Cells(行番号, 列番号).Value = Mid(txt, 文字位置, 1)
Next 文字位置
' ===== 対象文字列文字位置のｶｳﾝﾄｱｯﾌﾟE =====
' ===== 漢字列のｶｳﾝﾄｱｯﾌﾟS =====
For 漢字列 = 漢字最小列 To 漢字最大列
漢字名 = Worksheets(Est).Cells(読取行, 漢字列).Value
If 漢字名 <> "" Then
文字位置 = InStr(Worksheets(Est).Cells(読取行, 読取列).Value, _
漢字名)
If 文字位置 > 0 Then
行番号 ＝ 最小行 + 文字位置 – 1
列英字名 = Replace(Worksheets(Wst).Cells(1, 列番号) _
.Address(False, False), "1", "")
枠領域 = 列英字名 & 行番号
Worksheets(Wst).Range(枠領域).Borders.LineStyle _
= xlContinuous
Worksheets(Wst).Range(枠領域).Value = ""
ふりがな読取列 = 漢字列 + 最大枠数
ふりがな名 = Worksheets(Est).Cells(読取行, ふりがな読取列).Value
If ふりがな名 <> "" Then
ふりがな列 = 列番号 + 1
列英字名 = Replace(Worksheets(Wst).Cells(1, ふりがな列) _
.Address(False, False), "1", "")
枠領域 = 列英字名 & 行番号
Worksheets(Wst).Range(枠領域).Value = ふりがな名
Worksheets(Wst).Range(枠領域).Font.Size = 8
Worksheets(Wst).Range(枠領域).HorizontalAlignment _
= -4131
Worksheets(Wst).Range(枠領域).Orientation = -4166
Worksheets(Wst).Range(枠領域).ShrinkToFit = True
End If
End If
End If
Next 漢字列
' ===== 漢字列のｶｳﾝﾄｱｯﾌﾟE =====
列番号 = 列番号 + 書込ステップ列
Next 読取行
' ===== 読取行のｶｳﾝﾄｱｯﾌﾟE =====
'◆◆◆◆◆◆◆◆◆◆◆◆◆◆ 漢字解答集 ◆◆◆◆◆◆◆◆◆◆◆◆◆◆
Wst = WSheetKT
読取最大行 = Worksheets(Est).Cells(Rows.Count, "B").End(xlUp).Row
' ===== 読取行のｶｳﾝﾄｱｯﾌﾟS =====
For 読取行 = 読取最小行 To 読取最大行
問題番号 = Worksheets(Est).Cells(読取行, 読取問題番号列).Value
書込問題番号行 = Int((問題番号 - 1) / 書込列数) * 書込ステップ行 _
+ 書込問題番号最小行
最小行 = 書込問題番号行 + 1
列番号 = 最大列 + ((問題番号 - 1) Mod 書込列数) * 書込ステップ列
' Wst = Worksheets(Est).Cells(読取行, 書込ワークシート列).Value
列英字名 = Replace(Worksheets(Wst).Cells(1, 列番号) _
.Address(False, False), "1", "")
枠領域 = 列英字名 & 書込問題番号行
Worksheets(Wst).Range(枠領域).Value = 問題番号
Worksheets(Wst).Range(枠領域).Font.Size = 10
txt = Worksheets(Est).Cells(読取行, 読取列).Value
最大文字数 = Len(txt)
' ===== 対象文字列文字位置のｶｳﾝﾄｱｯﾌﾟS =====
For 文字位置 = 1 To 最大文字数
行番号 ＝ 最小行 + 文字位置 - 1
Worksheets(Wst).Cells(行番号, 列番号).Value = Mid(txt, 文字位置, 1)
Next 文字位置
' ===== 対象文字列文字位置のｶｳﾝﾄｱｯﾌﾟE =====
' ===== 漢字列のｶｳﾝﾄｱｯﾌﾟS =====
For 漢字列 = 漢字最小列 To 漢字最大列
漢字名 = Worksheets(Est).Cells(読取行, 漢字列).Value
If 漢字名 <> "" Then
文字位置 = InStr(Worksheets(Est).Cells(読取行, 読取列).Value, _
漢字名)
If 文字位置 > 0 Then
行番号 ＝ 最小行 + 文字位置 – 1
列英字名 = Replace(Worksheets(Wst).Cells(1, 列番号) _
.Address(False, False), "1", "")
枠領域 = 列英字名 & 行番号
Worksheets(Wst).Range(枠領域).Borders.LineStyle _
= xlContinuous
Worksheets(Wst).Range(枠領域).Value = ""
ふりがな読取列 = 漢字列 + 最大枠数
ふりがな名 = Worksheets(Est).Cells(読取行, ふりがな読取列).Value
If ふりがな名 <> "" Then
ふりがな列 = 列番号 + 1
列英字名 = Replace(Worksheets(Wst).Cells(1, ふりがな列) _
.Address(False, False), "1", "")
枠領域 = 列英字名 & 行番号
Worksheets(Wst).Range(枠領域).Value = ふりがな名
Worksheets(Wst).Range(枠領域).Font.Size = 8
Worksheets(Wst).Range(枠領域).HorizontalAlignment _
= -4131
Worksheets(Wst).Range(枠領域).Orientation = -4166
Worksheets(Wst).Range(枠領域).ShrinkToFit = True
End If
End If
End If
Next 漢字列
' ===== 漢字列のｶｳﾝﾄｱｯﾌﾟE =====
列番号 = 列番号 + 書込ステップ列
Next 読取行
' ===== 読取行のｶｳﾝﾄｱｯﾌﾟE =====
End Sub
それでは、マクロ『シートから複数シート2』を実行してみます。
_ 『漢字問題集』シート
_ 『漢字解答集』シート
『漢字入力帳』シートに用意した10問の漢字文字列が、
出題漢字を空欄にした『漢字問題集』シートと、
出題漢字をそのまま残した『漢字解答集』シートへ、
書きこまれました。