【他のレンジ/シート/ブックを更新する】
1 あるレンジから別レンジを更新
2 あるシートから別シートを更新
3 逆Ｚ式並びで更新
4 セルで指定したシートを更新
5 複数シートを連続更新
6 Subプロシージャの定義と呼び出し
7 あるブックから別ブックを更新
セルで指定したシートを更新
今回は、Excel VBA/マクロによって、あるシートからデータを読みとり
セルで指定した別シートへデータを書きこんでみます。
前回は、『漢字入力帳』シートからデータを読みとり、『漢字学習帳』シートへデータを書きこみました。
今回は、『漢字入力帳』シートからデータを読みとり、『漢字学習帳A』シート、
または、『漢字学習帳B』シートへデータを書きこんでみます。
そこで、その準備として、Excelマクロ有効ブック内に、『漢字入力帳』シートと
『漢字学習帳A』・『漢字学習帳B』シートを作成しておきましょう。
前回使用したExcelマクロ有効ブックをコピーして『9_他の複数シートを更新1.xlsm』を作成します。
『漢字入力帳』シート
書込ワークシートとして『漢字学習帳A』シートと『漢字学習帳B』シートの
どちらのワークシートに何を書き込むかを予め決めておく必要があります。
書込ワークシートをどのシートにするかを決める方法は何通りもありますが、
今回は、『漢字入力帳』シートのK列に書込ワークシート名を予め記入しておき、
マクロ実行時に問題番号毎にそれを読みとることにします。
マクロ『シートからシート5』を、マクロ『シートから複数シート1』に名前を変えます。
宣言部を改修します。
定数『Wst = "漢字学習帳"』をコメントアウト
定数『書込ワークシート列』に『K』列を代入
書込ワークシートを文字列型の変数『Wst』として定義
’ Const Wst = "漢字学習帳"
Const 書込ワークシート列 = "K"
Dim Wst As String
処理部を改修します。
読取行のカウントアップのループの中で、
『漢字入力帳』シートの11列(K列)の書込ワークシートを変数『Wst』に格納
For 読取行 = 読取最小行 To 読取最大行
・・・・・・・・・・・・・・・・・・・・・・
Wst = Worksheets(Est).Cells(読取行, 書込ワークシート列).Value
・・・・・・・・・・・・・・・・・・・・・・
Next 読取行
【マクロ『シートから複数シート1』】
Sub シートから複数シート1()
Const Est = "漢字入力帳"
’ Const Wst = "漢字学習帳"
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
読取最大行 = 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
それでは、マクロ『シートから複数シート1』を実行してみます。
_ 『漢字学習帳A』シート
_ 『漢字学習帳B』シート
『漢字入力帳』シートに用意した10問の漢字文字列が、文字分割されて
『漢字学習帳A』シートに1～5問、『漢字学習帳B』シートに6～10問が書きこまれました。