エクセルVBAによる業務処理 |
||
|
||
■例 題■ 先日、とある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にデータが存在しているかどうかのチェック」と「各シートに残っている(かもしれない)以前のデータのクリア」は無視しました。 上記のプロシージャなら、将来的に統合するシート数に変動があった場合、またエクセルのバージョン違い等で最大行数に変化があった場合などでも最低限の修正で済みます。 |