送付票自動印刷ツール改良計画

問題解決編

 指摘された問題は二点であった。今回はそれを解消してみようと思う。問題は二点だったが対処箇所は三箇所である。

シート行数の決め打ち問題

 シート行数を60000に固定していた問題の解決は実はとても簡単である。ようはシートの行数が分かればよいのだから、ワークシートの行数をカウントしてしまえばいいのである。実はそういうプロパティメソッドがあるのだ。

 送付票自動印刷ツールでは、ワークシートをワークシート変数に設定している。なので名簿データを格納しているシート「名簿」を代入した変数、WSadの行をカウントするとよい。その書式は、WSad.Rows.Countである。WSadのRowsプロパティのCountプロパティを参照するに対しCountメソッドを適用している。これによって得られる値は、Excel 2000の場合65536である。

 こうして得られる値は、プログラム内での使い勝手を考えて変数に代入するのが一般的だ。送付票ツールでもRowEndという変数を用いているのだが、私ははじめこれを整数型(Integer)としていた。ところが整数型の扱える範囲は-32768から32767であり、65536が入るとオーバーフローしてしまう。なのでRowEndを整数型から長整数型(Long)に変えておく必要がある。

宛先宛名、宛名のみ対応問題

 宛先のみ、宛名のみのデータに対応できるよう、データ行数範囲取得のやり方も変更しよう。

 片一方しかないデータがあっても正しく評価できるようにするのなら、宛先列、宛名列双方の最終行を取得して、どちらか大きな値を持つかを調べてやればいい。また、第一行を選択してからEnd(elDown)で下に下がるやり方では、途中に存在しうる空白セルが引っ掛かりとなって、正しい値が出なくなる。なので、シートの最下行を選択し、End(xlUp)で上昇するように変更した。

 ソースを一部抜きだしてみよう。なお分かりやすいようにコメントを多めに加えてある。

'範囲の検出
WSad.Select
RowEnd = WSad.Rows.Count 'RowEndにシート行数を代入
RowEnd1 = Cells(RowEnd, 1).End(xlUp).Row '第一列最下行から上昇、データ最下行を取得
RowEnd2 = Cells(RowEnd, 2).End(xlUp).Row '第二列最下行から上昇、データ最下行を取得

If RowEnd1 >= RowEnd2 Then '宛先列行数が宛名列行数以上だったら、
    RowEnd = RowEnd1 'RowEndに宛先列行数を代入
ElseIf RowEnd1 < RowEnd2 Then '宛名列行数が宛先列行数より大きかったら、
    RowEnd = RowEnd2 'RowEndに宛名列行数を代入
EndIf
If RowEnd = 1 Then GoTo ProsEnd 'RowEndが1だったら作業をとばして終了プロセスにジャンプ

宛先宛名、多様性未対応問題

 宛先しかないもの、宛名しかないものを振り分けて処理したいなら、そういうときはIfを使ってやればいい。宛先だけのものは宛先に「御中」をつけて印刷、宛名だけなら宛名に「様」をつけて印刷。両方揃っていたら最初の通りにしてやればいいし、両方ない行があったらなにもしないでやればいい。

 ということで、その処理部分のコードを書いてみた。コメントをつけるほどでもないので、さっきのソースサンプルのコメントを参考にして、適当に読み取って欲しい。

If Katagaki = "" Then
    If Not Namae = "" Then
        WSpr.Cells(2, 3).Value = Namae & "様"
        WSpr.PrintOut
    End If
ElseIf Namae = "" Then
    WSpr.Cells(2, 3).Value = Katagaki & "御中"
    WSpr.PrintOut
Else
    WSpr.Cells(2, 3).Value = Katagaki & vbNewLine & "   " & Namae & "様"
    WSpr.PrintOut
End If

送付票自動印刷マクロ全文改良版

Sub 送付票自動印刷()
Dim RowEnd As Long
Dim RowEnd1 As Long
Dim RowEnd2 As Long
Dim RowChk As Integer
Dim Katagaki As String
Dim Namae As String
Dim WSad As Worksheet
Dim WSpr As Worksheet

'作業ワークシートの設定
Set WSad = ThisWorkbook.Sheets("名簿")
Set WSpr = ThisWorkbook.Sheets("様式")

'範囲の検出
WSad.Select
RowEnd = WSad.Rows.Count
RowEnd1 = Cells(RowEnd, 1).End(xlUp).Row
RowEnd2 = Cells(RowEnd, 2).End(xlUp).Row

If RowEnd1 >= RowEnd2 Then
    RowEnd = RowEnd1
ElseIf RowEnd1 < RowEnd2 Then
    RowEnd = RowEnd2
EndIf
If RowEnd = 1 Then GoTo ProsEnd

'値の取得と印刷の実行
WSpr.Select
RowChk = 2
Do While RowChk <= RowEnd
    Katagaki = WSad.Cells(RowChk, 1).Value
    Namae = WSad.Cells(RowChk, 2).Value

If Katagaki = "" Then
    If Not Namae = "" Then
        WSpr.Cells(2, 3).Value = Namae & "様"
        WSpr.PrintOut
    End If
ElseIf Namae = "" Then
    WSpr.Cells(2, 3).Value = Katagaki & "御中"
    WSpr.PrintOut
Else
    WSpr.Cells(2, 3).Value = Katagaki & vbNewLine & "   " & Namae & "様"
    WSpr.PrintOut
End If

    RowChk = RowChk + 1
Loop

'終了の手順
ProsEnd:

WSpr.Cells(2, 3).Value = "あて先" & vbNewLine & "   氏名" & "様"

WSad.Select
WSad.Cells(1, 1).Select
WSpr.Select
WSpr.Cells(1, 1).Select

End Sub

 While...Wend文がDo...Loop文になっていたり、その際の条件がちょっと変わっていたりと、細かな変更もあったりするのだが、基本的には前回あげた問題点の改良に留めている。実をいえば、印刷用シート「様式」のデータが入力されるセルを、ソース内にその都度記述するのではなくて、Rangeオブジェクト変数を宣言してコピー先セルを代入したほうが、後々のメンテナンス性において有利であるなどなど、分かっていながら放置しているものもあったりする。

 プログラムというものは、同じ処理をするのに幾通りもの書き方をできるのであって、上に紹介しているのはごく単純な例にすぎない。なのでより便利で強力なツールを求めるのであればいくらでも改良の余地はあるし、同じことをよりスマートに処理することもできるだろう。

 けれど、わたしゃもういい。これで動くし充分便利だし、これ以上を求めてもコストに対するメリットが感じられないから、これで終わりにしておこう。


<

わたしの愛した機械へ トップページに戻る

公開日:2003.09.03
最終更新日:2003.09.04
webmaster@kototone.jp
Creative Commons License
こととねは、クリエイティブ・コモンズ・ライセンス(表示 - 継承 2.1 日本)の下でライセンスされています。