もっと知りたい「動的配列」
1 値を保持する「ReDim Preserve」
配列の宣言については過去記事を記載しております。
bimori466-1.hatenablog.com
この記事で触れていなかった動的配列の値を保持する方法について説明します。
どういうときに値の保持を使うのか?
例を出します。以下のコードをご覧ください。
Sub 配列の値を保持して再宣言() Dim myArr() As String ReDim myArr(1 To 1) myArr(1) = "A001" 'あっ、"A002"を追加しなきゃ(;^ω^) ReDim Preserve myArr(1 To 2) myArr(2) = "A002" Debug.Print myArr(1) Debug.Print myArr(2) End Sub
<処理解説>
1 配列変数myArr(1) を再定義。
2 myArr(1)にA001を代入。
3 配列変数myArr(2) を再定義。
*この時、myArr(1) の値を消したくないので「ReDim Preserve myArr(1 To 2)」と記述します。「Preserve=保持」の意味です。
4 myArr(2)にA002を代入
5 イミディエイトウィンドウに値を表示。
<イミディエイトウィンドウの結果>
A001、A002が表示されています。つまり、myArr(1)の値は保持されていることがわかりますね!
つまり、配列の要素数を拡張できるのです!
2 動的配列の弱点
しかし、2次元配列は行の要素数を増やすことができません。
(*注:TRANSPOSE関数で行と列を入れ替えれば、追加することは可能です。ここでは割愛しますm(_ _"m))
例を出します。
以下の画像のような表から商品コードが「Aで始まる行」の2次元配列を作成します。
以下のコードをご覧ください。
Sub 動的配列_二次元配列の要素数は増やせない() Dim myArr() As Variant Dim ws As Worksheet: Set ws = Worksheets("sheet1") Dim lastRow As Long Dim arrCount As Long lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row Dim i As Long For i = 2 To lastRow If ws.Cells(i, 1).Value Like "A*" Then arrCount = arrCount + 1 ReDim Preserve myArr(1 To arrCount, 1 To 3) myArr(arrCount, 1) = ws.Cells(i, 1).Value myArr(arrCount, 2) = ws.Cells(i, 2).Value myArr(arrCount, 3) = ws.Cells(i, 3).Value End If Next End Sub
結論、以下の通り実行時エラーとなります。
エラー部分のコード
ReDim Preserve myArr(1 To arrCount, 1 To 3)
arrCount=2のときにエラーとなります。
つまり、行は要素の追加ができません。
(*注:列の要素数の追加はできます。myArr(1 To 1,1 To 4)は可能です。横に要素を増やすことはできます。)
これが2次元配列の「ReDim Preserve」の弱点です。
3 弱点を補うユーザー定義型(Type)
じゃあ配列の行を増やすことは諦めないといけないの??
諦めないで!ユーザー定義型(Type)というものがあります。
ユーザー定義型変数とは、複数の型・値を1つの変数名で管理する事が出来る型のことです。
では先ほどできなかった、商品コードが「Aで始まる行」の配列を作成しましょう!
<Typeを使った処理コード>
Type 商品 商品コード As String 商品名 As String 在庫数 As Long End Type Sub Typeを使って配列を保持() Dim myArr() As 商品 Dim ws As Worksheet: Set ws = Worksheets("sheet1") Dim lastRow As Long Dim arrCount As Long lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row Dim i As Long For i = 2 To lastRow If ws.Cells(i, 1).Value Like "A*" Then arrCount = arrCount + 1 ReDim Preserve myArr(1 To arrCount) myArr(arrCount).商品コード = ws.Cells(i, 1).Value myArr(arrCount).商品名 = ws.Cells(i, 2).Value myArr(arrCount).在庫数 = ws.Cells(i, 3).Value End If Next Debug.Print myArr(1).商品コード; " " & myArr(1).商品名 & " " & myArr(1).在庫数 Debug.Print myArr(2).商品コード; " " & myArr(2).商品名 & " " & myArr(2).在庫数 End Sub
*注:Typeはモジュールの宣言セクションに記載に記載します!
<処理結果>
画像の蛍光線部の通り、配列の値が保持されていることがわかります。
4 クラスモジュールの自作コレクションを使う
配列とは異なりますが、ユーザー定義(Type)のように、クラスモジュールを使ってコレクションに複数の要素を持たせることができます。
*注:クラスモジュールで記述しないといけません。標準モジュールでコレクションにTypeで宣言することはできません。
クラスモジュールを使って、以下の表のSheet1のデータをSheet2に転記する処理を実行します(データ数20万件)。
<Sheet1のデータを、>
<Sheet2に列D「金額」を計算したものを転記します>
準備するモジュール
クラスモジュール×2、標準モジュール×1の計3つ
<クラスモジュール1 要素を定義する「商品コード」>
Option Explicit Public 商品コード As String Public 単価 As Long Public 在庫数 As Long Public 金額 As Currency
<クラスモジュール2 要素数を追加するメソッドを作る「商品コード群」>
Option Explicit Public 商品コード群 As Collection Private Sub class_initialize() Set 商品コード群 = New Collection End Sub Public Sub Add(ByVal new商品コード As String, ByVal new単価 As Long, ByVal new在庫数 As String, ByRef new金額 As Currency) Dim p As 商品コード: Set p = New 商品コード With p .商品コード = new商品コード .単価 = new単価 .在庫数 = new在庫数 .金額 = new金額 End With 商品コード群.Add p, new商品コード End Sub
<標準モジュール 金額を求める「My商品Collection2」>
Sub My商品Collection2() Dim my商品 As 商品コード群: Set my商品 = New 商品コード群 Dim ws As Worksheet: Set ws = Worksheets("Sheet4") Dim lastRow As Long: lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row Dim i As Long For i = 2 To lastRow DoEvents my商品.Add ws.Cells(i, 1), ws.Cells(i, 2), ws.Cells(i, 3), (ws.Cells(i, 2) * ws.Cells(i, 3)) ws.Cells(i, 4) = my商品.商品コード群(i - 1).金額 '列Dに金額を代入 Next End Sub
処理の流れ
1 変数my商品を商品コード群として、インスタンス化する。
2 変数lastRowに最終行を取得する。
3 変数my商品に、クラスモジュールのメソッドADDを実行する
4 変数my商品に商品コード群を追加する。(商品コード、単価、在庫数、金額)
5 列Dに金額を求める(ws.Cells(i, 4) = my商品.商品コード群(i - 1).金額 )。
結論:この処理にかかる時間は「23分3秒」です。クソ遅いw。使えたもんじゃない。
このことをTwitterに投稿したところ、コードを見てもらって、なぜ遅いのかを調べてもらったところ以下の回答をもらいました。
プログラムが遅い一番の原因は、たぶん、下記の行です。
ws.Cells(i, 4) = my商品.商品コード群(i - 1).金額
Colletionからの読み出しで、読み出したい要素の番号を指定すると、一気に遅くなります。
つまり、my商品(1).金額と表示できれば速度が上がるはず!ということに気づきました。
しかし、現状のクラスモジュールではmy商品(1).金額と表示することができません。
しか~し、解決方法がパーフェクトVBAに載っています。
Attribute(属性)を編集する。
Attributeとはなんぞや?
ざっくり説明すると、VBE上では操作できない設定を、対象のモジュールをエクスポートして、テキストエディタなどで「Attribute」から始まる命令文を追記して、その後インポートすることで、設定できるものです。
いやいや、VBE上で設定できないなんてありかよ~(;^ω^)って感じですが、そうらしいですw
で、本題の「ws.Cells(i, 4) = my商品.商品コード群(i - 1).金額」→「ws.Cells(i, 4) = my商品().金額」するのか?
具体的に説明していきます。
1)クラスモジュールに、クラスのデフォルトメンバーに追加する処理を追記する。
<クラスモジュール 商品コード群に追記>
Public Property Get 商品index(ByVal index As Variant) As 商品コード Set 商品index = 商品コード群(index) End Property
全体的にクラスモジュールをもう一度見ると以下の通り。
<クラスモジュール 商品コード群 Property Get追記後>
Option Explicit 'クラスモジュール_商品コード群 Public 商品コード群 As Collection Private Sub class_initialize() Set 商品コード群 = New Collection End Sub Public Sub Add(ByVal new商品コード As String, ByVal new単価 As Long, ByVal new在庫数 As String, ByRef new金額 As Currency) Dim p As 商品コード: Set p = New 商品コード With p .商品コード = new商品コード .単価 = new単価 .在庫数 = new在庫数 .金額 = new金額 End With 商品コード群.Add p, new商品コード End Sub Public Property Get 商品index(ByVal index As Variant) As 商品コード Set 商品index = 商品コード群(index) End Property
このコード(商品コード群)をエクスポートします。
5 終わりに…
いかがだったでしょうか。配列に入れると処理速度はあがりますが、動的配列でまさかの行の追加がシンプルにできません(;^ω^)
TRANSPOSE関数を使って追加する方法もありますが、シンプルじゃないのでは私の好みではありません。
Typeを使うと、シンプルに行のデータを増やすことができます。
2次元配列の動的配列の行は、動的にPreserveで値を保持して再宣言できないというお話でした。
「ReDim Preserve」は処理が遅くなるのでは?と思われるかもですが、10万件ほどのデータであれば、1秒以内に終わるようです。そんなに遅くは無いようです。
ではでは、この辺で(^^)/~~~
エクセルVBA、「配列の宣言」
目次
1 配列のメリット
2 配列の宣言は2つある!
1)静的配列
2)動的配列
3 静的配列、動的配列どちらが便利か?
4 1次元配列と2次元配列
1)2次元配列の宣言(静的配列)
2)2次元配列の宣言(動的配列)
5 セルデータから簡単に配列を作る方法
6 終わりに…
1 配列のメリット
同じ型の変数を宣言しなくてよい!
例を出して説明します。以下のコードをご覧ください↓↓。
Sub study_Array() Dim name1 As String Dim name2 As String name1 = "佐藤" name2 = "鈴木" End Sub
変数nameの数だけ変数宣言します。1~2までしかありませんが、これが100個あったらどうでしょう??100行分の変数を宣言するのか?それは面倒だろ!という話になります。
この面倒さを解消するために「配列」が存在します。
2 配列の宣言は2つある!
1) 静的配列
先ほどの話を例に、100個の配列を宣言するにはどうすればいいのか?それは以下のコードのように宣言します。
Sub 静的配列() Dim myName(99) As String End Sub
なぜ99なのか。理由は「0で始まるから」です。ローカルウィンドウで変数myNameを確認すると、以下の画像の通り。
では、0スタートではなく、1スタートにするにはどう記述すればいいのか。答えは以下のコードの通り。
Sub 静的配列() Dim myName(1 to 100) As String End Sub
以下の画像の通り、1スタートになります。
(「Option Base 1」をモジュールの先頭に記述しておけば、myName(100)で、要素数が100になります!詳細は割愛しますm(_ _"m))
つまり、静的配列とは「最初から宣言する配列要素数が決まっている」ものになります。
では、動的配列とは何なのか?事項で説明します。
2) 動的配列
動的配列とは「あらかじめ要素数が決まっていないもの」。つまり、要素数が不確定なものです。
何を言ってるか分からないですよね(;^ω^)
説明します!
例えば、あなたが何かのセミナーを開催してるとします。セミナーの参加者名簿を作ります。参加者は、日によって異なりますよね。20人の時もあれば、今日は15人だったみたいな。そういう場合に、今回は要素数15、次は20と「変化する要素数を確定させて配列を宣言する」のです。
百聞は一見に如かず。例を出します。
上の画像の通り、
1/25は10人、
1/26は5人、
1/27は3人の参加者がいます。
1/25~1/27の参加者を動的配列で宣言するにはどうすればいいか。以下のコードの通りです。
Sub 動的配列1() Dim ws As Worksheet: Set ws = Worksheets("sheet1") Dim x As Integer, y As Integer, z As Integer Dim myArr() As String '動的配列の宣言 x = ws.Cells(Rows.Count, 1).End(xlUp).Row - 1 '25日 y = ws.Cells(Rows.Count, 2).End(xlUp).Row - 1 '26日 z = ws.Cells(Rows.Count, 3).End(xlUp).Row - 1 '27日 ReDim myArr(1 To x) '10個の配列ができる ReDim myArr(1 To y) '5個の配列ができる ReDim myArr(1 To z) '3個の配列ができる End Sub
ReDimで動的配列myArrを作成します。今回は変数x,y,zに25~27日の生徒数を代入しています。
xは10個の配列が、yは5個の配列が、zは3個の配列ができます。
動的配列に値を代入してみる。
1/25の10個の配列に、生徒コードのデータを代入してみましょう!コードは以下の通りです。
Sub 動的配列2() Dim ws As Worksheet: Set ws = Worksheets("sheet1") Dim x As Integer, y As Integer, z As Integer Dim myArr() As String '動的配列の宣言 x = ws.Cells(Rows.Count, 1).End(xlUp).Row - 1 '25日 ReDim myArr(1 To x) '10個の配列ができる '動的配列に値を代入 Dim i As Integer For i = 1 To x myArr(i) = ws.Cells(i + 1, 1) Next End Sub
このコードを動かして、ローカルウィンドウを見ると、以下の画像の通り動的配列myArrに生徒コードの値が代入できます。
3 静的配列、動的配列どちらが便利か?
私は、動的配列が便利だと思います。理由は「要素数の変化に対応できるから」です。
例えば以下のような商品コードリストがあるとします。
これを静的配列に値を代入するには以下のコードです。
Sub 静的配列3() Dim myName(1 To 10) As String myName(1) = Worksheets("Sheet2").Range("A2").Value myName(2) = Worksheets("Sheet2").Range("A3").Value myName(3) = Worksheets("Sheet2").Range("A4").Value myName(4) = Worksheets("Sheet2").Range("A5").Value myName(5) = Worksheets("Sheet2").Range("A6").Value myName(6) = Worksheets("Sheet2").Range("A7").Value myName(7) = Worksheets("Sheet2").Range("A8").Value myName(8) = Worksheets("Sheet2").Range("A9").Value myName(9) = Worksheets("Sheet2").Range("A10").Value myName(10) = Worksheets("Sheet2").Range("A11").Value End Sub
この処理の難点は何かというと、商品リストは日々増えていくということです。
以下の画像のように、商品リストは日々増加しますよね。
そうなると、静的配列の値代入のコードの書き直しが必要になります。
要素数が13個に変更した場合のコードは以下の通り。
Sub 静的配列3() Dim myName(1 To 13) As String myName(1) = Worksheets("Sheet2").Range("A2").Value myName(2) = Worksheets("Sheet2").Range("A3").Value myName(3) = Worksheets("Sheet2").Range("A4").Value myName(4) = Worksheets("Sheet2").Range("A5").Value myName(5) = Worksheets("Sheet2").Range("A6").Value myName(6) = Worksheets("Sheet2").Range("A7").Value myName(7) = Worksheets("Sheet2").Range("A8").Value myName(8) = Worksheets("Sheet2").Range("A9").Value myName(9) = Worksheets("Sheet2").Range("A10").Value myName(10) = Worksheets("Sheet2").Range("A11").Value myName(11) = Worksheets("Sheet2").Range("A12").Value myName(12) = Worksheets("Sheet2").Range("A13").Value myName(13) = Worksheets("Sheet2").Range("A14").Value End Sub
コードの変更部分は画像の蛍光線部の所です。
静的配列だと、このように要素数が変更する度にコードを追加、変更しなければなりません。これは面倒(;^ω^)
では、動的配列ではどうか。結論「コードの書き換えは不要」です。
<動的配列のコード>
Sub 動的配列3() Dim ws As Worksheet: Set ws = Worksheets("sheet2") Dim x As Integer Dim myArr() As String '動的配列の宣言 x = ws.Cells(Rows.Count, 1).End(xlUp).Row - 1 '最終行の取得 ReDim myArr(1 To x) '変数xの数だけ配列ができる '動的配列に値を代入 Dim i As Integer For i = 1 To x myArr(i) = ws.Cells(i + 1, 1) Next End Sub
<要素数が10の場合>
<要素数が13の場合>
明らかに動的配列が楽です。
しかし、静的配列も曜日のような定数的な値をいれる場合は効果的だと思います。
(例)曜日を静的配列に代入。
sub 静的配列_曜日 Dim Day_of_the_week(6) As String Day_of_the_week(0) = "日" Day_of_the_week(1) = "月" Day_of_the_week(2) = "火" Day_of_the_week(3) = "水" Day_of_the_week(4) = "木" Day_of_the_week(5) = "金" Day_of_the_week(6) = "土" End Sub
4 1次元配列と2次元配列
いままで説明してきたのが1次元配列についてです。ここからは2次元配列について説明していきます。
1)2次元配列の宣言(静的配列)
以下のようなエクセルの表があるとします。
この表を静的配列に代入してみましょう!
<2次元配列を静的配列に代入するコード>
Sub 静的配列_2次元配列1() Dim myProductArr(1 To 11, 1 To 3) As String Dim ws As Worksheet: Set ws = Worksheets("sheet3") Dim myRow As Long Dim myColumn As Long '配列に代入 For myRow = 1 To 11 For myColumn = 1 To 3 myProductArr(myRow, myColumn) = ws.Cells(myRow, myColumn).Value Next Next 'イミディエイトウィンドウに出力する。 Dim i As Integer For i = 1 To 11 Debug.Print myProductArr(i, 1) & " " & myProductArr(i, 2) & " " & myProductArr(i, 3) Next End Sub
処理結果は以下の画像の通り。
ローカルウィンドウを確認すると以下の画像の通り。2次元配列にデータが変数myProductArrにデータが代入されていることがわかります。
2)2次元配列の宣言(動的配列)
<2次元配列を動的配列に代入するコード>
Sub 動的配列_2次元配列1() Dim myProductArr() As String Dim ws As Worksheet: Set ws = Worksheets("sheet3") Dim myRow As Long Dim myColumn As Long Dim lastRow As Long Dim lastColumn As Long lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row lastColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column ReDim myProductArr(1 To lastRow, 1 To lastColumn) '配列に代入 For myRow = 1 To lastRow For myColumn = 1 To lastColumn myProductArr(myRow, myColumn) = ws.Cells(myRow, myColumn).Value Next Next 'イミディエイトウィンドウに出力する。 Dim i As Integer For i = 1 To 11 Debug.Print myProductArr(i, 1) & " " & myProductArr(i, 2) & " " & myProductArr(i, 3) Next End Sub
処理結果は以下の画像の通り(静的配列と同じ結果です)。
ローカルウィンドウを確認。(静的配列と同じ結果です)。
このように、静的配列は「Dim myProductArr(1 To 11, 1 To 3) As String」で2次元配列を宣言できます。
動的配列は、「Dim myProductArr() As String」で宣言し、「ReDim myProductArr(1 To lastRow, 1 To lastColumn)」で2次元配列を再宣言します。
5 セルデータから簡単に配列を作る方法
結論、配列変数をVariantで宣言してセルの範囲を代入する。
どういうことか分からないですよね(;^ω^)
説明します。
以下の画像の表をデータを配列に取り込みます。
以下のコードをご覧ください。
Sub Variantに配列を代入() Dim ws As Worksheet: Set ws = Worksheets("sheet3") Dim myAyy As Variant myAyy = ws.Range("A1:C11") End Sub
ローカルウィンドウを確認すると、変数myAyyに配列ができていることが確認できます。
配列データをセルに一括代入する。
セルから配列を作れる作れるように、
配列データをセルに一括で代入することができます。
例を出します。以下の画像のような表を用意します。
この表の「金額」を配列変数に取得した後計算し、配列変数ををセルに一括代入します。
<「金額」を求め、セルに配列を代入する処理コード>
Sub Variantに配列を代入2() Dim ws As Worksheet: Set ws = Worksheets("sheet4") Dim lastRow As Long Dim myAyy As Variant lastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row myAyy = ws.Range("A1:D" & lastRow) Dim i As Long '列Dの金額を配列に代入する処理 For i = 2 To lastRow myAyy(i, 4) = myAyy(i, 2) * myAyy(i, 3) Next '配列を列に代入する。 ws.Range("A1:D" & lastRow) = myAyy End Sub
コードの実行後の結果は以下の画像の通り。「金額」の値が代入されています!
20万件の計算処理時間は「3秒」です。
ちなみに、配列に入れずに、セル参照をして処理をすると「12秒」かかります。
なんと「1/4」の時間の短縮になります。
配列の便利さを理解頂けましたでしょうか??
6 終わりに…
以上が配列の宣言をざっくりまとめたものです。ReDimは値を保持する「Preserve」を使うパターンもあるのですが、またの機会に記載します。
記事記載しました↓↓
bimori466-1.hatenablog.com
ではでは、この辺で(^^)/~~~
ステータスバーを表示する方法
ステータスバーを表示する
以下の画像の通り、処理に時間のかかるマクロを動かす場合ステータスバーに処理状況を表示することがあると思います。
ステータスバーを処理方法をまとめたことがなかったので、調べてまとめました。
ステータスバーを表示するコード
Sub StatusBar変更() With Application .DisplayStatusBar = True .StatusBar = "時間のかかる処理をしています。" .DisplayStatusBar = False End With End Sub
「Application.DisplayStatusBar = True」にすることで、ステータスバーを表示します。
「Application.StatusBar」に表示したい文字を入力します。
「Application.DisplayStatusBar = False」でステータスバーの表示無くします。
処理時間のかかるマクロを動かす場合には活用するといいかもです!
Twitterでのツッコミ
ユーザー側の設定を勝手に変えてしまうと、場合によっては大問題につながるケースもある。
そこで、教えていただいたコードをまるパクリしましたw。
Sub StatusBar変更2() Dim DisplayStatusBar As Boolean With Application DisplayStatusBar = .DisplayStatusBar 'ステータスバーが非表示なら表示 If DisplayStatusBar = False Then .DisplayStatusBar = True 'ステータスバーの更新 .StatusBar = "時間のかかる処理をしています。" 'ステータスバーが非表示だったら元に戻す If DisplayStatusBar = False Then .DisplayStatusBar = False End With End Sub
これなら、変数DisplayStatusBar がTure、Falseでステータスバーの表示を切り替えられるのでユーザーの設定を変更せずに済みます!
ステータスバーの状態をBoolean型で取得するとは思いつきもしませんでした。勉強になりましたm(_ _"m)
ではでは、この辺で(^^)/~~~
VBA100本ノック 45本目:テーブルに列追加
この記事から得るもの
ListObjectの追加した行に、数式を一括代入する方法が分かる。
ListObjectの追加した行に、値のみを代入する方法が分かる。
1 今回のお題
シートにB2から始まる5列(列1,列2,列3,列4,列5)のテーブルあります。
・列3の後ろに列挿入して列1から列3の合計列を作成、見出しは"合計列1"
・テーブルの右端に列4から列5の合計列を作成、見出しは"合計列2
出来上がりは画像を参照してください。
※シートは任意
2 今回のお題の意図
DataBodyRangeを使って数式を一括代入すると楽ということを伝えたい。
3 回答
ListObjectについてまだ知識が浅いので、サイト管理者のコードをひとまずコピペしました。
サイト管理者のコード
Sub VBA100_45_01() Dim ws As Worksheet: Set ws = ActiveSheet With ws.Range("B2").ListObject With .ListColumns.Add(.ListColumns("列3").Index + 1) .Name = "合計列1" .DataBodyRange.Value = "=SUM([@[列1]:[列3]])" .DataBodyRange.Select End With With .ListColumns.Add .Name = "合計列2" .DataBodyRange.Formula = "=SUM([@[列4]:[列5]])" End With End With End Sub
DataBodyRangeって何??
マイクロソフトのサイト解説によると、「テーブルの見出しの行を除く、値の範囲を表す Range オブジェクトを返します。 読み取り専用です。」との記述でした。
例文
ActiveSheet.ListObjects.Item(1).DataBodyRange.Select
この処理を実行すると、選択されるセルは以下の画像の通りです。
マイクロソフトの解説の通り、テーブルの見出しの行を除く、値の範囲を表す Range オブジェクトが選択されました。
しかし、これではすべてのデータ部が選択されてしまいます。なので、追加した列だけを選択するにはどうしたらいいか。
以下のコード部をみてください。
With ws.Range("B2").ListObject With .ListColumns.Add(.ListColumns("列3").Index + 1) .Name = "合計列1" .DataBodyRange.Value = "=SUM([@[列1]:[列3]])" .DataBodyRange.Select End With
「.DataBodyRange.Select」を実行すると、追加した行のデータ部のみを選択します。
また、「.DataBodyRange.Value = "=SUM([@[列1]:[列3]])"」で一括で追加した行にSumの数式を代入でき、簡単に数値の合計を入力できます。以下の画像をご覧ください。
セルに数式を入れたくない!という私のポリシー
このデータ量なら問題ないのですが、リストが大きくなると数式を入れるとデータ量が重くなり動作が遅くなります。個人的には、セルに数式を代入するのは好きではありません。
しかし、「.DataBodyRange.Value」は数式を一括代入はできるのですが、値のみを代入することはできないようです。そのため、私の考えたコードは以下になります。
私の作成したコード
Sub ノック45本目_1() '変数定義------------------------------------------------------- Dim ws As Worksheet: Set ws = Worksheets("Sheet1") Dim lastRow As Long, k_listRow As Long '________________________________________________________________ lastRow = ws.Range("A1").ListObject.Range.Rows.Count '追加行のデータ作成、数値合計 With ws.Range("A1").ListObject .ListColumns.Add Position:=4 .ListColumns(4).Range(1) = "合計列1" For k_listRow = 2 To lastRow .ListColumns(4).Range(k_listRow) = WorksheetFunction.Sum(Range(Cells(k_listRow, 1), Cells(k_listRow, 3))) Next .ListColumns.Add .ListColumns(7).Range(1) = "合計列2" For k_listRow = 2 To lastRow .ListColumns(7).Range(k_listRow) = WorksheetFunction.Sum(Cells(k_listRow, 5), Cells(k_listRow, 6)) Next End With End Sub
リストを追加する部分は同じです。異なる点は、「.DataBodyRange.Value = "=SUM([@[列1]:[列3]])"」で数式を一括代入するのではなく、For Nextでループし、「WorksheetFunction.Sum」で数値を合計し値のみを追加した行に代入しています。これなら、大量のリストでもデータ量は軽くなるばずです。
PATHの末尾に「¥」を付ける自作関数
「¥」を付ける自作関数
Twitterで、マクロにエラーが出た原因が最後に「¥」を付けていないのが原因でエラーだったというツイートを見ました。
その返信で、自作関数で作っている!という方がいたので、自分でも作ってみました。
自作関数コード
Sub パス設定() Dim myPath As String myPath = SetPath(ThisWorkbook.Path) MsgBox myPath End Sub Function SetPath(ByRef beforPath As String) As String If Len(beforPath) <> 0 Then If Right(beforPath, 1) = "¥" Or Right(beforPath, 1) = "/" Then SetPath = beforPath Else SetPath = beforPath & "¥" End If End If End Function
★注 「¥」はブログ上全角となっております。コピペした後は、半角「¥」へ訂正が必要です!!
変数myPath にThisWorkbookのPathを取得する。
Right関数を使って、末尾「¥」or「/」でなければ「¥」をつける。
この自作関数をPath設定時に記述に追加すれば、エラーに悩む時間が減る!!
これをアドインで展開すれば楽になるのだろうか??
ではでは、この辺で(^^)/~~~
保育料日付入力Form。一時保育時に、封筒に手書きで書いていることを楽にする。
保育料日付入力Formの作成の経緯
妻が仕事をするために1ヵ月の間に12日、子どもを一時保育に預けています。その際に、毎回上記の添付写真の封筒を手書きで作っていました。
「それ面倒じゃない?」と聞くと、「いや、1月に12回だけだからw」と返答され、ありえない!面倒くさい!意味わからん!と、私のよくわからない情熱が燃え、この作業を自動化するVBAを作成することにしました。
1 閲覧対象者
お子さんを一時保育などに預けており、毎回手書きで「保護者名」、「園児名」、「緊急連絡先」、「登園日」、「金額」を書いている方。
2 得られる効果
手書きからの解放!!
処理イメージ↓↓
処理イメージ:「保育料日付入力Form」 pic.twitter.com/u1EVBUomV1
— かずやん_VBAerLv.6 (@y8bV4ty1wbkTjPd) 2021年1月12日
「登園日」以外は固定されているので、今回は日付を入力するという点にフォーカスを当てた仕様となっております。
仮に「登園日」以外に変更がある場合は、都度変更すればよいかと思います。
3 設計
1 「保護者名」、「園児名」、「緊急連絡先」、「金額」はマニュアル入力。
2 マクロ「登園日入力」を実行
3 ユーザーフォームが表示される。
4 登園する日付のCheckboxをチェックし、登録ボタンをクリックする。
5 日付が入力される。
4 コードの解説
コードの中身
標準モジュールが1つと、Formモジュール(Calender)1つ、計2つがあります。
<標準モジュール>
(Formモジュール(Calenderを呼出す(Show)するだけ)
<フォームモジュール>
標準モジュールは、今日の日付(Date)を取得してFormモジュール(Calender)を呼び出すだけです。なので、標準モジュールの説明は省きます。
メイン処理は、Formモジュール(Calender)になります。
Formモジュール(Calender)の処理
UserForm_Initialize処理(ここがメイン処理です!)
<UserForm_Initializeのコード>
Private Sub UserForm_Initialize() Dim Day_of_the_week(6) As String Day_of_the_week(0) = "日": Day_of_the_week(1) = "月": Day_of_the_week(2) = "火" Day_of_the_week(3) = "水": Day_of_the_week(4) = "木": Day_of_the_week(5) = "金" Day_of_the_week(6) = "土" '曜日のラベルを作成---------------------------------------------- Dim newLabel As MSForms.Label Dim k_Day_of_the_week As Byte For k_Day_of_the_week = 0 To 6 '名前をつけてラベルを追加 Set newLabel = Me.Controls.Add("Forms.Label.1", "lab_" & Day_of_the_week(k_Day_of_the_week)) With newLabel .Caption = Day_of_the_week(k_Day_of_the_week) 'キャプション .Font.Size = 14 '文字サイズ .Width = 35 '横幅 .Height = 18 '縦幅 .Left = 24 + (40 * k_Day_of_the_week) '左からの距離 .Top = 60 '上からの距離 '.BorderStyle = fmBorderStyleSingle 'ラベルに線で囲う。 If Day_of_the_week(k_Day_of_the_week) = "日" Then .ForeColor = &HFF& '文字色を赤 ElseIf Day_of_the_week(k_Day_of_the_week) = "土" Then .ForeColor = &HFF0000 '文字色を青 Else .ForeColor = &H0& '文字色を黒 End If .TextAlign = fmTextAlignCenter End With Set newLabel = Nothing Next '________________________________________________________________ 'コンボボックス登録処理------------------------------------------ Dim i As Integer For i = -3 To 3 '前後3年分の年を登録 Me.cmb_year.AddItem CStr((Year(clndr_date)) + i) Next i For i = 1 To 12 '月を登録 Me.cmb_month.AddItem CStr(i) Next i Me.cmb_year = Year(clndr_date) '年を指定 Me.cmb_month = Month(clndr_date) '月を指定 '________________________________________________________________ '日付のcheboxを作成-------------------------------------------------- Dim DayLabel As MSForms.CheckBox Dim Left_IX As Integer, Top_IX As Integer, n As Byte Dim k_DayLabel As Byte Left_IX = 0: Top_IX = 0: n = 0 For k_DayLabel = 1 To 37 Set DayLabel = Me.Controls.Add("Forms.CheckBox.1", "lab_Day_" & k_DayLabel) '名前をつけてラベルを追加 With DayLabel .Caption = k_DayLabel '後で削除 .TextAlign = fmTextAlignCenter .Font.Size = 14 '文字サイズ .Width = 35 '横幅 .Height = 18 '縦幅 .Left = 25 + (40 * Left_IX) '左からの距離 .Top = 100 + (18 * Top_IX) '上からの距離 '.BorderStyle = fmBorderStyleSingle 'ラベルに線で囲う。 If k_DayLabel Mod 7 = 0 Then .ForeColor = &HFF0000 '文字色を青 ElseIf k_DayLabel Mod 7 = 1 Then .ForeColor = &HFF& '文字色を赤 Else .ForeColor = &H0& '文字色を黒 End If End With 'Debug.Print Me("lab_Day_" & k_DayLabel).Caption Set DayLabel = Nothing Left_IX = Left_IX + 1 n = n + 1 '7個作ったら、下に作る判定 If n = 7 Then n = 0 Top_IX = Top_IX + 1 Left_IX = 0 End If Next '____________________________________________________________________ Call spn_日付_Spinup 'この処理をしないと面倒なことに… End Sub
Formモジュール(Calender)の処理手順
1 配列変数Day_of_the_weekに日曜~土曜日の文字列を格納します。
Dim Day_of_the_week(6) As String Day_of_the_week(0) = "日": Day_of_the_week(1) = "月": Day_of_the_week(2) = "火" Day_of_the_week(3) = "水": Day_of_the_week(4) = "木": Day_of_the_week(5) = "金" Day_of_the_week(6) = "土"
2 曜日のラベルを作成
上の画像の通り、フォームモジュールには曜日のラベルはありません。ラベルを作るコードを記述しています。
<ラベルを作成するコード>
'曜日のラベルを作成---------------------------------------------- Dim newLabel As MSForms.Label Dim k_Day_of_the_week As Byte For k_Day_of_the_week = 0 To 6 '名前をつけてラベルを追加 Set newLabel = Me.Controls.Add("Forms.Label.1", "lab_" & Day_of_the_week(k_Day_of_the_week)) With newLabel .Caption = Day_of_the_week(k_Day_of_the_week) 'キャプション .Font.Size = 14 '文字サイズ .Width = 35 '横幅 .Height = 18 '縦幅 .Left = 24 + (40 * k_Day_of_the_week) '左からの距離 .Top = 60 '上からの距離 '.BorderStyle = fmBorderStyleSingle 'ラベルに線で囲う。 If Day_of_the_week(k_Day_of_the_week) = "日" Then .ForeColor = &HFF& '文字色を赤 ElseIf Day_of_the_week(k_Day_of_the_week) = "土" Then .ForeColor = &HFF0000 '文字色を青 Else .ForeColor = &H0& '文字色を黒 End If .TextAlign = fmTextAlignCenter End With Set newLabel = Nothing Next '________________________________________________________________
「Set newLabel = Me.Controls.Add("Forms.Label.1", ラベル名)」この処理でラベルを作ります。作った後は、文字、配置などを微調整します。
蛍光線の部分のラベルが作成される。
3 コンボボックス登録処理
年、月のコンボボックスに値を代入します。年は±3年、月は1~12の値を代入します。これで、±3年の日付の入力ができます。
<コンボボックス登録処理のコード>
'コンボボックス登録処理------------------------------------------ Dim i As Integer For i = -3 To 3 '前後3年分の年を登録 Me.cmb_year.AddItem CStr((Year(clndr_date)) + i) Next i For i = 1 To 12 '月を登録 Me.cmb_month.AddItem CStr(i) Next i Me.cmb_year = Year(clndr_date) '年を指定 Me.cmb_month = Month(clndr_date) '月を指定 '________________________________________________________________
4 日付のcheboxを作成処理
ラベル同様に、カレンダーの日付もフォームモジュール内には存在しないので、コードから作成します。
<日付のcheboxを作成するコード>
'日付のcheboxを作成処理------------------------------------------ Dim DayLabel As MSForms.CheckBox Dim Left_IX As Integer, Top_IX As Integer, n As Byte Dim k_DayLabel As Byte Left_IX = 0: Top_IX = 0: n = 0 For k_DayLabel = 1 To 37 Set DayLabel = Me.Controls.Add("Forms.CheckBox.1", "lab_Day_" & k_DayLabel) '名前をつけてラベルを追加 With DayLabel .Caption = k_DayLabel '後で削除 .TextAlign = fmTextAlignCenter .Font.Size = 14 '文字サイズ .Width = 35 '横幅 .Height = 18 '縦幅 .Left = 25 + (40 * Left_IX) '左からの距離 .Top = 100 + (18 * Top_IX) '上からの距離 '.BorderStyle = fmBorderStyleSingle 'ラベルに線で囲う。 If k_DayLabel Mod 7 = 0 Then .ForeColor = &HFF0000 '文字色を青 ElseIf k_DayLabel Mod 7 = 1 Then .ForeColor = &HFF& '文字色を赤 Else .ForeColor = &H0& '文字色を黒 End If End With Set DayLabel = Nothing Left_IX = Left_IX + 1 n = n + 1 '7個作ったら、下に作る判定 If n = 7 Then n = 0 Top_IX = Top_IX + 1 Left_IX = 0 End If Next '____________________________________________________________________
「Set DayLabel = Me.Controls.Add("Forms.CheckBox.1", チェックボックス名)」これで、日付のチェックボックスを作成します。
5 この処理をしないと面倒なことに…
最後にちょこんと書いてあるこのコード。
Call spn_日付_Spinup 'この処理をしないと面倒なことに…
何をしているかと言うと、スピンボタンをスピンアップしています。
なぜこんなことをするのか?変数clndr_dateにDate関数で日付を取っているから、翌月を表示するため…ではありません。解決できないエラーがあったからです(;^ω^)。
仮にこの処理をしなかった場合、フォームの表示は下の画像の通りになります。
UserForm_Initializeの処理が流れただけの結果となります。これではカレンダーとは言えません。
スピンボタンにスピンUP、Downしたときに、カレンダーを作成する処理を走らせています。
その処理を実行すると、カレンダーが作成されます。つまり、自分でもあまり分かっていません(;^ω^)
動いてるからいいかなぁ(;^ω^)という状態です。
故に、スピンUP、Down時のイベント処理「clndr_set」のなかで、 On Error Resume Nextでエラーを無視しています。
この理由がわかる方は教えていただけると幸いです。しかし、設計に対して必要な要件は満たしています。
朗報 エラーの原因わかりました。
結論
UserForm_Initializeの最後「Call spn_日付_Spinup 」→「Call clndr_set」。
そもそも、UserForm_Initializeでカレンダー作成処理をやっていないことが原因でした(;^ω^)
なので、カレンダー作成処理を実行すればOKです。noteも更新しておりますm(_ _"m)
ご指摘くださったお二方、本当にありがとうございましたm(_ _"m)
<clndr_setのコード>
Private Sub clndr_set() 'カレンダーの作成と表示 Dim yy As String, mm As Integer, i As Integer, n As Integer, endDay As Integer If Me.cmb_year = "" Or Me.cmb_month = "" Then Exit Sub '年か月どちらか入ってなければ中止 yy = Me.cmb_year '年 mm = Me.cmb_month '月 On Error Resume Next For i = 1 To 37 'ラベルの初期化 Me("lab_Day_" & i).Caption = "" Me("lab_Day_" & i).BackColor = Me.BackColor Next n = Weekday(yy & "/" & mm & "/" & 1) - 1 'その月の1日の曜日番号に、マイナス1したもの endDay = Day(DateAdd("d", -1, DateAdd("m", 1, yy & "/" & mm & "/" & "1"))) '月末日の算出 For i = 1 To endDay Me("lab_Day_" & i + n).Caption = i '日を入れる If CDate(yy & "/" & mm & "/" & i) = clndr_date Then Me("lab_Day_" & i + n).BackColor = RGB(200, 200, 200) 'TextBoxの日と同じなら色をつける Next i On Error GoTo 0 End Sub
この処理で、カレンダーを作成しています。
VBA100本ノック 44本目:全テーブル一覧作成
1 今回のお題
ブック内の全シート全テーブルについて、以下の情報をシートに出力してください。
・A列にテーブル名(テーブル1)
・B列にシート名(Sheet1)
・C列にセル範囲($B$2:$F$12)
・D列にリスト行数(10)
・E列にリスト列数(5)
※()内は画像の出力例
※対象ブック及び出力シートは任意
2 今回のお題の意図
お題を読んだだけでは意図が分からなかったので補足動画GIFをつけました↓↓
ノック44本目:処理イメージ pic.twitter.com/vXpaGFf3tn
— かずやん_VBAerLv.5 (@y8bV4ty1wbkTjPd) 2021年1月8日
動画の例で言うと、Sheet1~Sheet3の中にテーブルが計4つあります。そのテーブルの情報(テーブル名、シート名、セル範囲、行数、列数)を取得することが今回のお題の意図になっています。
3 回答
ListObjectを初めて知ったので、順を追って解説していきます。
まずは、Sheetにテーブルが存在するかどうかを判断しなければなりません。判断するためのコードが以下のコード↓↓
Sub テーブルが存在するか判定する_アクティブシート() Dim listObjectCount As Integer Dim DB1 As ListObject listObjectCount = ActiveSheet.ListObjects.Count If ActiveSheet.ListObjects.Count = 0 Then MsgBox "テーブルは存在しません。" Else MsgBox "テーブルが存在します。" End If For Each DB1 In ActiveSheet.ListObjects Debug.Print DB1.Name Next End Sub
処理結果
これはSheet3をActiveにした時の処理結果です。テーブルが2つあるので、イミディエイトウィンドウに2つのテーブル名を返します。
重要な点は、「 ActiveSheet.ListObjects.Count」で、SheetにあるListObjectsの数を数えられるという点です。
つまり、このお題をクリアするためにはすべてのSheetをループして、ListObjectsの数だけループすればよいということです。
私の最終回答
Option Explicit Sub ノック44本目_2() '変数宣言-------------------------------------------------------- Dim sh As Worksheet Dim listObjectCount As Integer Dim i As Integer Dim tableName As String Dim tableSheetName As String Dim tableRange As String Dim tableRowCount As Long Dim tableColumnCount As Long Dim ws As Worksheet: Set ws = Worksheets("テーブル一覧") Dim write_IX As Long: write_IX = ws.Cells(Rows.Count, 1).End(xlUp).Row '________________________________________________________________ For Each sh In Sheets listObjectCount = sh.ListObjects.Count For i = 1 To listObjectCount tableName = sh.ListObjects(i).Name tableSheetName = sh.Name tableRange = sh.ListObjects(i).Range.Cells.Address tableRowCount = sh.ListObjects(i).Range.Rows.Count tableColumnCount = sh.ListObjects(i).Range.Columns.Count '書込み処理 write_IX = write_IX + 1 ws.Cells(write_IX, 1) = tableName ws.Cells(write_IX, 2) = tableSheetName ws.Cells(write_IX, 3) = tableRange ws.Cells(write_IX, 4) = tableRowCount ws.Cells(write_IX, 5) = tableColumnCount Next Next End Sub
処理手順
1Book内Sheetをループ
2ListObjectsの数だけループ
3WorkSheets(”テーブル一覧”)に書き込む
4 感想
テーブル機能はこれまでまったく使ってこなかったので、これからは使っていこうと思います!
ではでは、この辺で(^^)/~~~