部屋割りマクロ(Excel)(3)
部屋割りマクロのリファクタリング
このときに作成した部屋割りマクロのコードを見直して修正した。
問題点その１
isFull_変数が無意味
Roomクラスの内部に、インスタンスが定員一杯であることを表すisFull_というPrivate変数を置いていたのだが、全く使用していなかったので、使うようにした。
そこで、
のリスト１のallocateメソッドのところを書き換える。
リスト１ クラスモジュール
Public Function allocate() As Boolean If isFull_ Then allocate = False: Exit Function '……(1)' capacityOf_ = capacityOf_ - 1 If capacityOf_ = 0 Then isFull_ = True '……(2)' allocate = True End Function
変えたのは(1)と(2)のところ。
(1)の
If isFull_ Then allocate = False: Exit Function
isFull_がTrueだったら部屋割り不能なので、Falseを返す。
isFull_がFalseの場合は、部屋割り可能なので、次の行の
capacityOf_ = capacityOf_ - 1
で定員を1減ずる。
で、その後(2)の
If capacityOf_ = 0 Then isFull_ = True
で、定員が0になっていたら、isFull_をTrueに切り替える。
これで、次回この部屋インスタンスに部屋割りしようとするとallocateメソッドがFalseを返すことになる。
問題点その２
部屋割り処理が不細工すぎる
これは、
のリスト２の
Dim isAllocated As Boolean
Dim n As Integer
n = 1
Dim Sh As Worksheet
Set Sh = targetRange.Parent
Do
For i = 1 To roomCount
With rooms(i)
If Not Sh.Rows(targetRange.Cells(n, 1).Row).Hidden Then
If .allocate Then
targetRange.Cells(n, 1).Value = .nameOf
n = n + 1
If n > targetRange.Count Then Exit For
End If
Else '……(*)'
i = i - 1
n = n + 1
If n > targetRange.Count Then Exit For
End If
End With
Next
Loop Until n > targetRange.Count
この部分。改めて見直すと、マジで何がしたいのか分からんｗｗｗ
行き当たりばったりでテキトーにコーディングするとこうなる。
個人的には、特に(*)のところがヒド過ぎると思う。Forループの中でイテレータ変数をデクリメントさせるとか、正気の沙汰ではないｗｗｗ
これは根本から考え直す必要があると思った。
で、修正したのがコチラ。
リスト２ 標準モジュール
Dim isAllocated As Boolean
Dim n As Integer
n = 1
Dim Sh As Worksheet
Set Sh = targetRange.Parent
Dim tmpCell As Range
For i = 1 To targetRange.Rows.Count
Set tmpCell = targetRange.Cells(i, 1) '……(1)'
If Not Sh.Rows(tmpCell.Row).Hidden Then '……(2)'
Do Until rooms(n).allocate '……(3)'
n = n + 1 '……(4)'
If n > roomCount Then n = 1
Loop
tmpCell.Value = rooms(n).nameOf '……(5)'
n = n + 1 '……(6)'
If n > roomCount Then n = 1
End If
Next
変更前は、部屋の方をForループで回していたのだけれど、これがそもそもの間違いだったわけですな。
部屋の方は定員一杯になるまで何周もするんですからね。
今回は、部屋割り対象セルを上から順にForで回す、というやり方に改めた。
まず、(1)の
Set tmpCell = targetRange.Cells(i, 1)
部屋割り対象セルを変数tmpCellにぶち込む。後々カンタンに記述するためだけの措置です。
で、(2)の
If Not Sh.Rows(tmpCell.Row).Hidden Then
で、tmpCellの行が非表示になっているかどうかを判定。
非表示でなければ、ブロック内の部屋割り処理に移る。
tmpCellが非表示になっていなければ、(3)からの４行
Do Until rooms(n).allocate n = n + 1 '……(4)' If n > roomCount Then n = 1 Loop
で割り振るべき部屋を探す。
入り口のところでRoomクラスのallocateメソッドを実行してTrueが返ってきたら、n 番目の部屋に部屋割り可能ということなので、Loopを抜けて次に進む。
allocateメソッドがFalseだったら、(4)からの２行
n = n + 1 If n > roomCount Then n = 1
で n をインクリメントする。ただし、 n が部屋数を超えてしまったら n を1に戻す。
で、次。
ここまで来たら、後は部屋割り対象セルに部屋の名前を書き込むだけなので、(5)の
tmpCell.Value = rooms(n).nameOf
で部屋の名前を書き込み、(6)からの２行
n = n + 1 If n > roomCount Then n = 1
で n をインクリメント、つまり部屋を次の部屋に進める。
おわりに
まあ、だいぶマシなコードになったとは思います。
「作業グループ」状態をVBAで作るには[Excel]
「作業グループ」状態にする
複数のシートにまとめて変更を加えたいときには「作業グループ」状態にする。
しかし、VBAからExcelを操作するときに、あまり「作業グループ」状態を使うことがなかった。
そういえば、どうやるんだろう？
で、確かめてみた。
マクロの記録
ちょっと分かりにくく、かつわけのわからない画像ですまない。
とにかく、２番目～４番目のシートを選択して、「作業グループ」状態にしてある。
これだけで操作をやめ、マクロの記録を終了。んで、できたコードがコチラ。
リスト１ 標準モジュール
Sub Macro1()
'
' Macro1 Macro
'
'
Sheets(Array("ち～んｗ 1 号（笑）", "ち～んｗ 2 号（笑）", "ち～んｗ 3 号（笑）")).Select
Sheets("ち～んｗ 1 号（笑）").Activate
End Sub
へえ！ 知らんかった！Sheetsコレクションのインデックスに配列をぶち込んだら複数シート選択状態になるのか！
記録マクロだと、シート名の配列を作っているみたいだけれど、これでいけるんなら別にインデックス番号でもいいはず。
で、これを用いてちょっとやってみた。
データを差し込んでは新しいシートを追加し、最後にまとめて印刷するマクロ
Wordの差込印刷みたいな要領で、シートの一部にそれぞれ異なるデータを差し込みつつ新規シートとして追加していき、全部追加し終わったところで一気に印刷プレビュー表示→印刷、という流れの簡単なコードを書いてみた。
シート「Main」には、こんなふうに準備しておく。
Ａ２セルにデータ（笑）を差し込んでいく、という設定。
リスト２ 標準モジュール
Public Sub insertionPrintByAddSheets()
Dim Sh As Worksheet
Set Sh = ThisWorkbook.Worksheets("Main")
Dim i As Integer
For i = 1 To 3
With ThisWorkbook '……(1)'
Sh.Copy After:=.Worksheets(.Worksheets.Count) '……(2)'
With .Worksheets(.Worksheets.Count) '……(3)'
.Range("A2").Value = "ち～んｗ " & i & " 号（笑）" '……(4)'
.Name = .Range("A2").Value '……(5)'
End With
End With
Next
Dim ar(2) As Integer '……(6)'
For i = 0 To 2
ar(i) = i + 2
Next
With ThisWorkbook.Worksheets(ar) '……(7)'
.PrintPreview
.PrintOut
End With
Sh.Select '……(8)'
End Sub
とりあえず実験なので、追加するシートは３つだけにした。
まず(1)からの９行
For i = 1 To 3
With ThisWorkbook
Sh.Copy After:=.Worksheets(.Worksheets.Count) '……(2)'
With .Worksheets(.Worksheets.Count) '……(3)'
.Range("A2").Value = "ち～んｗ " & i & " 号（笑）" '……(4)'
.Name = .Range("A2").Value '……(5)'
End With
End With
Next
のForループでは、「Main」シートの内容をコピーして新しいシートを追加しつつ、データ（笑）を差し込む。
まず(2)の
Sh.Copy After:=.Worksheets(.Worksheets.Count)
で現時点での最終シートの次に新しいシートを追加していく。
引数「After」の指定の仕方は、今回の場合は別に
.Worksheets(i)
でも大丈夫だと思うけれど、後で「Main」意外にも固定のシートが生じた場合に書き換える必要が生ずるので、このようにした。
(3)からのWithブロック
With .Worksheets(.Worksheets.Count)
.Range("A2").Value = "ち～んｗ " & i & " 号（笑）" '……(4)'
.Name = .Range("A2").Value '……(5)'
End With
は、新しくできたシートに対する処理。Worksheetsコレクションのインデックス番号に、この時点でのWorksheetsコレクションの数を指定しているので、確実に追加されたばかりのシートを指定することができる。
まず(4)の
.Range("A2").Value = "ち～んｗ " & i & " 号（笑）"
で、新しく追加されたシートのＡ２セルにデータ（笑）を差し込み、
(5)の
.Name = .Range("A2").Value
でシート名を差し込んだデータ（笑）に変えている。
ここまでで必要なシートが出そろったことになる。
お次は、(6)からの４行。
Dim ar(2) As Integer For i = 0 To 2 ar(i) = i + 2 Next
新しく追加したシートをまとめて指定するのに使う配列を準備する。
今回は２シート目～４シート目（最終シート）なのでこんな感じにする。
「2」とか、マジックナンバー丸出しだが、あくまで実験用なのでご容赦を。実際には引数で対応することになるだろう。
後は(7)からの４行
With ThisWorkbook.Worksheets(ar) .PrintPreview .PrintOut End With
で配列「ar」で指定されたインデックス番号のシート（今回の場合は、「2」「3」「4」番目のシート）に対してPrintPreviewメソッドとPrintOutメソッドを実行する。
これで処理そのものは終わりだが、「作業グループ」状態になっていることに気づかずにシートを加工して大惨事、ということになったら困るので、
(8)の
Sh.Select
で、元のシートをSelectして終わるようにした。
実行結果
紙でプリントアウトしてもブログでは表現が難しいので、プリンタはJUST PDFを指定してある。
まずプレビューが表示される。画像では全く伝わらないが、ちゃんと３ページ分ある。
しかる後、印刷が実行されて、PDFが表示された。
ちゃんと３ページ分一気に表示されている。
おわりに
「直接操作でしかやらないような動作」というのがあって、そういうのは簡単な操作なのに、案外VBAでどうやるか知らないもんだなあ、ということです。
コレクションのインデックスを配列で指定するという発想は、正直全くありませんでした。
真の最終行番号を取得するFunction(2)
真の最終行を取得するFunctionの修正
前回の
にさっそくツッコミがｗ
@excelspeedupさん曰く、
currentregion使うと、完全な空白行が入っているとき誤動作しませんか？
と。
ははは。確かにおっしゃるとおり。
場合分けミスですな。
たとえば、
こんなふうにデータ（笑）が入っていたとして、
こんなふうに行を選択して
非表示にされてしまったら、
こんなふうに意図しない行番号が返ってしまう。
「真の最終行番号」の看板に偽りありですがな。
コードの修正
というわけで、前回のリスト１を次のように修正する。
リスト１ 標準モジュール
Public Function getLastRowNumber( _
ByVal targetColumn As Long, _
Optional ByVal targetSheet As Worksheet) As Long
If targetSheet Is Nothing Then Set targetSheet = ActiveSheet
Dim tmpLastRow As Long
'暫定的な最終行を求める'
tmpLastRow = getLastRowNumberNormal(targetColumn:=targetColumn, _
targetSheet:=targetSheet)
'UsedRangeの最終行番号を求める'
Dim maxRowNumber As Long
maxRowNumber = targetSheet.UsedRange.Rows.Count '……(*)'
'tmpLastRowとmaxRowNumberが一致していれば、それが最終行'
If tmpLastRow = maxRowNumber Then getLastRowNumber = tmpLastRow: Exit Function
'maxRowNumberの方が大きい場合は、真の最終行を探す'
Dim i As Long
For i = maxRowNumber To tmpLastRow Step -1
With targetSheet
If .Cells(i, targetColumn).Value <> "" Then
getLastRowNumber = i
Exit Function
End If
End With
Next
End Function
'指定した列の最終行を返す'
Public Function getLastRowNumberNormal( _
ByVal targetColumn As Long, _
Optional ByVal targetSheet As Worksheet) As Long
If targetSheet Is Nothing Then Set targetSheet = ActiveSheet
getLastRowNumberNormal = targetSheet.Cells(Rows.Count, targetColumn).End(xlUp).Row
End Function
変えたのは(*)のところだけ。
単純に、UsedRangeの最終行番号をmaxRowNumberにぶち込むようにしただけ。
ちなみに、
この状態でイミディエイト・ウインドウに
?Activesheet.UsedRange.Rows.Count
と入力して[Enter]を押すと、
ご覧のように「23」が返る。非表示にしているのも「使用中」ということらしい。
使ってみる
イミディエイト・ウインドウに
?getLastRowNumber(Range("P1").Column)
と入力して[Enter]を押す。
今度は「21」が返った。
ご名算！
おわりに
ただ、UsedRangeを使うと、意味もなく最終行（100万超！）まで罫線が設定されたりしていたら、おっそろしいことになるんよなあ……。
真の最終行番号を取得するFunction
真の最終行番号を求めるFunction
Twitterで、
オートフィルターで非表示になっている行があると、最終行番号の取得に失敗して困る
みたいなツイを見た。
なるほど、データの入っている最終行を非表示にして、[Ctrl]+[↑]で確かめると、確かに
表示されている中で値の入っている最終行のセル
にカーソルが飛ぶ。
これは困った現象だ。
そこで、非表示になっていたとしても正確に値の入った最終行番号を返すようなFunctionを考えてみた。
考え方
非表示の行があったとしても、CurrentRegionプロパティで取得するRangeオブジェクトのRows.Countプロパティは実際の行数を返すようなので、それを利用する。
手順としては、
- 通常の方法（Endプロパティを使うアレ）でひとまず暫定の最終行を求める ･･･ ①
- 暫定の最終行にあるセルを基準にCurrentRegionを取得する
- CurrentRegionの最終行番号を求める ･･･②
- ①と②が等しければ、それが真の最終行番号
- ②の方が①よりも大きい場合は、②～①の間に値のあるセルがあれば、そこが最終行
こんな感じ。
この考えに基づいてコーディングしてみた。
コーディング
リスト１ 標準モジュール
Public Function getLastRowNumber( _
ByVal targetColumn As Long, _
Optional ByVal targetSheet As Worksheet) As Long
If targetSheet Is Nothing Then Set targetSheet = ActiveSheet
Dim tmpLastRow As Long
'暫定的な最終行を求める'
tmpLastRow = getLastRowNumberNormal(targetColumn:=targetColumn, _
targetSheet:=targetSheet)
Dim tmpReferenceCell As Range
Set tmpReferenceCell = targetSheet.Cells(tmpLastRow, targetColumn)
'暫定的な最終行にあるセルのCurrentRegion最終行番号を求める'
Dim maxRowNumber As Long
maxRowNumber = getCurrentRegionLastRowNumber(referenceCell:=tmpReferenceCell)
'tmpLastRowとmaxRowNumberが一致していれば、それが最終行'
If tmpLastRow = maxRowNumber Then getLastRowNumber = tmpLastRow: Exit Function
'maxRowNumberの方が大きい場合は、真の最終行を探す'
Dim i As Long
For i = maxRowNumber To tmpLastRow Step -1
With targetSheet
If .Cells(i, targetColumn).Value <> "" Then
getLastRowNumber = i
Exit Function
End If
End With
Next
End Function
'指定した列の最終行番号を求める ……(1)'
Public Function getLastRowNumberNormal( _
ByVal targetColumn As Long, _
Optional ByVal targetSheet As Worksheet) As Long
If targetSheet Is Nothing Then Set targetSheet = ActiveSheet
getLastRowNumberNormal = targetSheet.Cells(Rows.Count, targetColumn).End(xlUp).Row
End Function
'CurrentRegionの最終行数を取得する ……(2)'
Public Function getCurrentRegionLastRowNumber( _
ByVal referenceCell As Range) As Long
With referenceCell
If .Count <> 1 Then Set referenceCell = .Cells(1, 1)
End With
Dim Sh As Worksheet
Set Sh = referenceCell.Parent
With referenceCell.CurrentRegion
getCurrentRegionLastRowNumber = .Cells(.Rows.Count, 1).Row '……(3)'
End With
End Function
メインは先頭のgetLastRowNumber。内部で(1)のgetLastRowNumberNormalと(2)のgetCurrentRegionLastRowNumberを呼び出すような処理にしている。
(1)、(2)とも、単独でも使い道がありそうなので、PrivateではなくPublic指定している。
(1)の
Public Function getLastRowNumberNormal( _
ByVal targetColumn As Long, _
Optional ByVal targetSheet As Worksheet) As Long
If targetSheet Is Nothing Then Set targetSheet = ActiveSheet
getLastRowNumberNormal = targetSheet.Cells(Rows.Count, targetColumn).End(xlUp).Row
End Function
は、おなじみEndプロパティを用いて最終行番号を求めているだけ。
(2)の
Public Function getCurrentRegionLastRowNumber( _
ByVal referenceCell As Range) As Long
With referenceCell
If .Count <> 1 Then Set referenceCell = .Cells(1, 1)
End With
Dim Sh As Worksheet
Set Sh = referenceCell.Parent
With referenceCell.CurrentRegion
getCurrentRegionLastRowNumber = .Cells(.Rows.Count, 1).Row '……(3)'
End With
End Function
は、受け取ったセルのCurrentRegionの最終行番号を求めるFunction。先頭の３行
With referenceCell If .Count <> 1 Then Set referenceCell = .Cells(1, 1) End With
は、今回の使い道には関係ない。単独でCurrentRegionの最終行番号を求める用途で使うときに、引数に複数セルが渡された場合の対応。
(3)の
With referenceCell.CurrentRegion getCurrentRegionLastRowNumber = .Cells(.Rows.Count, 1).Row End With
がちょい分かりにくいかも。
CurrentRegionの最終行番号を求めるために、Cellsプロパティを用いてCurrentRegionの１列目最終行のセルを取得し、そのセルのRowプロパティを参照することによってCurrentRegionの最終行番号を取得している。
CurrentRegionは必ず矩形なので、１列目で良いと判断した。
メインのgetLastRowNumber内の処理は、コチラに書いたとおりなので、特に説明はいらないかな。
使ってみる
まず、シートに
こんな表を用意して、
17、18行目を非表示にして実験。
イミディエイト・ウインドウに
?getLastRowNumber(Range("P1").Column)
と入力して[Enter]！
ほれ、このとおり、ちゃんと真の最終行番号が返っておる。
今度は、オートフィルターでやってみる。
14、15行目の安道全と時遷を非表示にしてから、イミディエイト・ウインドウに
?getLastRowNumber(Range("D1").Column)
と入力して[Enter]！
ほれ、このとおり真の最終行番号が返った。
おわりに
ご意見承ります。
省略可能なオブジェクト型引数のデフォルト値
省略可能なオブジェクト型の引数のデフォルト値
省略可能な引数
プロシージャに省略可能な引数を設定するときには、
Public Sub hogeHoge(Optional ByVal foo As String = "ち～んｗ")
というふうに書く。
引数名の指定の最初に「Optionalキーワード」を付けて省略可能であることを示し、最後に「 = ～～」の形でデフォルト値を設定することができる。
ここまではまあ、たいていの人が知っているだろう。
じゃ、引数がオブジェクト型だったらどうすんのさ？
普通に書いてみる
とりあえず、
前回作成したFunctionはWorksheetオブジェクトが引数だったので、こいつを使う。
引数指定がない場合は、アクティブシートを渡す、という形にする。
まず、プロシージャの宣言の部分を
Public Function isAutoFiltered(Optional ByVal targetSheet As Worksheet = ActiveSheet) As Boolean
と書いてみる。
とりあえず、逐次コンパイルには引っかからない。
しかし、実行すると、
コンパイルエラーｗｗｗ
ま、当たり前ですけどね。
Public Function isAutoFiltered( _
Optional ByVal targetSheet As Worksheet Set targetSheet = ActiveSheet) _
As Boolean
こうも書いてみたけれど、これはもう逐次コンパイルに引っかかるレベルでダメｗ
結局、次のようになった。
リスト１
Public Function isAutoFiltered(Optional ByVal targetSheet As Worksheet) As Boolean If targetSheet Is Nothing Then Set targetSheet = ActiveSheet If targetSheet.AutoFilter.FilterMode Then isAutoFiltered = True End Function
引数が省略されると、targetSheetがNothingになるので、プロシージャの先頭でActiveSheetをセットするようにしただけ。
おわりに
先頭のカッコ内（引数指定のところ）でデフォルト値を設定する方法もあるのだろうか？？？
オートフィルターの状態を取得するFunction
オートフィルターの状態を取得する
元データが置いてあるワークシートがオートフィルターで絞り込まれているのに、それに気づかずにマクロを実行してわけのわからない結果が出て(ﾟДﾟ)ﾎﾟｶｰﾝとなったことはないだろうか。
わしはある!!!!!!!!
そんなわけで、オートフィルタの状態を表すオブジェクト、プロパティについて調べてみた。
Worksheet.AutoFilterオブジェクト
コチラによると、
指定されたワークシートのオートフィルターを示します。
AutoFilter オブジェクトを取得するには、 AutoFilter プロパティを使用します。
とのこと。
AutoFilter オブジェクトを取得するには、 AutoFilter プロパティを使用します
というのがちょっと分かりにくいけれど、
WorksheetオブジェクトのAutoFilterプロパティを参照すると、つまり、
「[Worksheetオブジェクト].AutoFilter」と書くと、
AutoFilterオブジェクトが返る
という理解で良いかと。
まあ、最初の指定されたワークシートのオートフィルターを示します
というのもよく分からんなｗ
「オートフィルターそのもの」とでも考えたら良いのかな。
AutoFilter.FilterModeプロパティ
再びコチラによると、
ワークシートがオートフィルター フィルター モードの場合、 True を返します。値の取得のみ可能です。ブール型 ( Boolean ) の値を使用します。
構文
式 . FilterMode
式AutoFilter オブジェクトを表す変数。
とのこと。
「フィルターモード」？？？ 何それ？？？（←素人）
フィルターモード
コチラによると、どうもフィルターで絞り込まれた状態を「フィルターモード」と言うらしい。
ｱｯｰｰｰ!!
そ、そういえば……、
こういうことかー！
はい、その程度のことも知らなかったExcel初心者ですよ、私は。
ここまでのまとめ
Worksheet.AutoFilterオブジェクトのFilterModeプロパティがTrueだったら、そのシートはどこかの列がオートフィルターで絞り込まれた状態であるということですね。
オートフィルターの状態を調べるFunction
無駄にFunction化する。
リスト１ 標準モジュール
Public Function isAutoFiltered(targetSheet As Worksheet) As Boolean If targetSheet.AutoFilter.FilterMode Then isAutoFiltered = True End Function
まあ、ほとんど冗談だと思ってください。
使ってみる
次のコードで実行する。
リスト２ 標準モジュール
Public Sub testIsAutoFiltered() Debug.Print isAutoFiltered(Selection.Parent) End Sub
選択範囲のあるシートについて、オートフィルターの状態をイミディエイトに表示するだけのコード。
こんな表を用意してオートフィルターを設定する。
こんなふうに「武松」と「楊志」（またこの２人ｗ）のチェックを外して、[OK]。
絞り込まれた。
範囲を選択して、リスト２を実行！
当然、「True」が返る。
念のため、
絞り込みを解除して実行。
ちゃんと「False」が返った。
おわりに
まあ、Function化するよりも、AutoFilterオブジェクトについてマスターしておくことの方が重要でしょうね。
オートフィルター、Rangeオブジェクト、２次元配列
※題名は、PINK FLOYDのオマージュです。
オートフィルターをかけたRangeオブジェクトを２次元配列にぶち込む
セル範囲の値を２次元配列にぶち込むお馴染みの方法。
ClearContentsメソッドでは非表示行が無視されたが、この場合はどうなるのか。
やってみた
この状態で、次のコードを実行。
リスト１ 標準モジュール
Public Sub testArray()
Dim Sh As Worksheet
Set Sh = ThisWorkbook.Worksheets("Sheet3")
Dim a As Variant
a = Sh.Range("D1").CurrentRegion.Value '……(*)'
Dim maxRow As Integer
Dim maxColumn As Integer
maxRow = UBound(a, 1)
maxColumn = UBound(a, 2)
Dim i As Integer
Dim j As Integer
Dim str As String
For i = 1 To maxRow
str = ""
For j = 1 To maxColumn
If j = 1 Then
str = a(i, j)
Else
str = str & " | " & a(i, j)
End If
Next
Debug.Print str
Next
End Sub
D1セルを含むアクティブセル領域の値を２次元配列 a にぶち込んで、Forループで値を取り出しながらイミディエイトに表示する、というアホみたいなコード。
当然こうなる。
一部非表示にしてやってみる
例によって「武松」と「楊志」を非表示にした。
この状態でリスト１を実行。
まったく同じ結果になった。
ちなみに、リスト１の(*)のところを
a = Selection.Value
としても結果は同じだった。
おわりに
「だから何？」とか言われても、知りません。
