エクセルVBAによる業務処理

「Microsoft社のExcel」 と言えば、今や表計算ソフトの代名詞と言っても過言ではありません。事実パソコン教室、事務系の職業訓練などでもWordと並んで必須のアイテムとなっています。
一般の企業でも、簡単なデータ集計や表の作成などは、Excelに予め用意されたワークシート関数、書式設定などを使えば誰にでも簡単に処理することが可能です。

但し、毎日のルーチンワークなどをいちいち手処理で行うのは時間の無駄でもあり、ケアレスミスにもつながりますので、できればしっかりしたマクロをVBAで組んでおくのが理想と思われます。

「エクセルの積木」ではデータのインポート〜集計〜書式設定〜印刷〜保存、などの一連の作業をマクロ化したサンプルを掲載していますので、ご参考頂ければ幸いです。
エクセルの積木へ
http://www9.plala.or.jp/siouxsie/excel/index.html
■例 題■

先日、とあるSOHOサイトの仕事依頼で見かけたマクロ作成業務の内容を例にとってみます。


●「Sheet1」「Sheet2」「Sheet3」のA列にあるデータを「Sheet4」のA列に統合し、それを任意の行数ずつ順番にテキストファイルとして保存したい。
ファイル名は「yyyymmddhhnnss」形式で作成。
但し空白セルが2つ続いたら(最終行まで来たら)マクロを中止したいとの事。


では上記案件で留意すべき点を整理して見ましょう。
尚、「作成するエクセルのバージョン」と「出力先フォルダ」は特に指示されていませんでした。

1、「Sheet1」「Sheet2」「Sheet3」のA列にあるデータを「Sheet4」のA列に統合する処理。

  └→統合する場合の順番は、Sheet1→2→3で良いのかどうか。
  └→データを統合する場合、最大件数のチェックが必要かどうか。
  └→将来的に統合するシートの増減があるのかどうか。

2、「Sheet4」のA列のデータを任意の行数ずつ順番にテキストファイルとして保存する。

  └→出力先のフォルダは任意に変更できた方が良いのかどうか。

以上の点を踏まえた上で、実際のプログラムを組んでみましょう。

■以下標準モジュールに記述

'↓宣言セクション

Const sakist As Integer = 4  'データ統合先のシートの指定(Sheet4)※将来的な増減を考慮しConstで宣言
Dim n As Long, s As Long

'↑ここまで


Sub exrow()  'シートの最下行を取得 ※エクセルのバージョンにより最大行数の違いを考慮

n = ActiveSheet.Rows.Count

End Sub



Sub ctsheet()
  '統合先シートのA列最下行のデータ行位置を取得

Worksheets("sheet" & sakist).Select

s = Range("A" & n).End(xlUp).Row

End Sub



Sub insheet()
  'データ元シートのA列のデータをデータの統合先のシートA列にコピーする処理

Dim i As Long
Dim motost As Variant

'↓シート1.2.3のデータを統合した場合、エクセルの最大行数以内に収まるかどうかのチェック
Call exrow
For Each motost In Array(1, 2, 3)  
'データ元の各シートA列のデータ数の計を求める
Call ctsheet
Worksheets("sheet" & motost).Select
i = Range("A" & n).End(xlUp).Row
i = i + d
d = i
Next motost

If d > n Then
MsgBox "統合したデータが、エクセルの最大行数(" & n & ")を超えています。", vbInformation
Exit Sub
End If
'↑チェック終了

'↓シート1.2.3のデータをシート4へ統合します
Call exrow
For Each motost In Array(1, 2, 3)
 'データ元のシートと統合する順番の指定 ※Array(2, 3, 1)ならシート2,3,1の順番

Call ctsheet
Worksheets("sheet" & motost).Select
i = Range("A" & n).End(xlUp).Row
Range(Cells(1, 1), Cells(i, 1)).Copy Destination:=Worksheets("sheet" & sakist).Range("A" & s + 1)

Next motost

Call ctsheet
Range(Cells(2, 1), Cells(s, 1)).Cut Destination:=Range("A1")
'↑統合終了
End Sub



Sub myoutput()  
'統合したシート4のデータをテキストファイルに書き出します

Dim myr As String, mysave As String
Dim j As Long, t As Long, r As Long, k As Long, c As Long, e As Long

Call ctsheet

'シート4のセルE1とE2に出力先のパスと1回の保存数を入力しておきます
mysave = Range("E1").Value  
'保存先フォルダへのパス(例:C:\data\)

k = Range("E2").Value  
'1回に保存するデータ数の指定(例:100)

t = Application.WorksheetFunction.RoundUp(s / k, 0)  
'データ数と指定の保存数からループ回数を求めます

c = 1 
'データの先頭値
e = k 
'データの最後値

For r = 1 To t

Open mysave & Format(Now, "yyyymmddhhnnss") & ".txt" For Output As #1

For j = c To e

myr = Cells(j, 1)

Print #1, myr
myr = ""

Next j

Close #1

c = c + k 
'データの先頭値を更新(保存数を加算)
e = e + k 
'データの最後値を更新(保存数を加算)

Application.Wait Now() + TimeValue("00:00:01")  
 'ファイル名が重複しない様、1秒間中断

Next r

End Sub



以上が自分なりの解答になります。

ちなみに「シート1,2,3にデータが存在しているかどうかのチェック」と「各シートに残っている(かもしれない)以前のデータのクリア」は無視しました。
上記のプロシージャなら、将来的に統合するシート数に変動があった場合、またエクセルのバージョン違い等で最大行数に変化があった場合などでも最低限の修正で済みます。