[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBAで繰り返しマクロ』(XXUO)
EXCEL2003の以下のようなVBAマクロの構文を教えてください。
下記のようにA列に文字が昇順で並んでいるワークブックXXがあります。
A 1あ 2あ 3あ 4い 5い 6う 7え 8お 9お
以下がマクロでやりたいことです。
?@I行目から、1行目と同じ文字の最下行(この場合は3行目まで)を切り取る
?A新しいワークブックを作り、開く
?Bそれに貼り付ける
?Cそれを保存し閉じる
?DワークブックXXに戻り、切り取られて空になった行を削除(そしてこの場合4行目が一番上に繰り上がる)
この?@〜?Dまでを繰り返し、ワークブックXXが空になったら終了する
< 使用 Excel:Excel2003、使用 OS:WindowsXP >
1)「あ」をオートフィルタで抽出
2)抽出された行をを新規ブックにコピペし保存
3)「い」をオートフィルタで抽出
4)抽出された行をを新規ブックにコピペし保存
こんな感じの操作を繰り返すとよいです。
そのために、準備として
「あ〜お」までの「重複のないリスト」が必要ですが
それには、フィルタオプションを使うと良いです。
まずは、手作業で試してみて、どういう手順になるか
理解したうえで、マクロに取り組むとよいです。
(マナ) 2016/12/03(土) 12:41
http://www.geocities.jp/chiquilin_site/data/060314_integrated_list.html
(マナ) 2016/12/03(土) 12:49
・フィルタオプションで「重複のないリスト」を作成するマクロ
・オートフィルタで、特定データのみ抽出するマクロ
・オートフィルタで抽出したデータのみをコピペするマクロ
・新規ブックを作成するマクロ
・ブックを名前を付けて保存するマクロ
・以上を繰り返すマクロ
(マナ) 2016/12/03(土) 13:02
マクロの記録をしてみました。
Sub Macro1()
'
' Macro1 Macro
'
'
Range("A1").Select Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove Range("A1").Select ActiveCell.FormulaR1C1 = "タイトル" Range("A2").Select Selection.Subtotal GroupBy:=1, Function:=xlCount, TotalList:=Array(1), _ Replace:=True, PageBreaks:=False, SummaryBelowData:=True Columns("B:B").Select Selection.SpecialCells(xlCellTypeConstants, 23).Select Range("B2:B5").Select Selection.Copy Sheets("Sheet2").Select ActiveSheet.Paste Sheets("Sheet2").Select Application.CutCopyMode = False Sheets("Sheet2").Copy ChDir "C:\Users\hiraigumit\Desktop" ActiveWorkbook.SaveAs Filename:="C:\Users\h\Desktop\111.xlsx", _ FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close Selection.ClearContents Sheets("Sheet1").Select Range("B7:B8").Select Selection.Copy Sheets("Sheet2").Select Range("A1").Select ActiveSheet.Paste Application.CutCopyMode = False Sheets("Sheet2").Select Sheets("Sheet2").Copy ActiveWorkbook.SaveAs Filename:="C:\Users\h\Desktop\222.xlsx", _ FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close Selection.ClearContents Sheets("Sheet1").Select Range("B10").Select Selection.Copy Sheets("Sheet2").Select Range("A1").Select ActiveSheet.Paste Sheets("Sheet2").Select Application.CutCopyMode = False Sheets("Sheet2").Copy ActiveWorkbook.SaveAs Filename:="C:\Users\h\Desktop\333.xlsx", _ FileFormat:=xlOpenXMLWorkbook, CreateBackup:=False ActiveWindow.Close Selection.ClearContents Sheets("Sheet1").Select Selection.RemoveSubtotal Columns("A:A").Select Selection.Delete Shift:=xlToLeft Range("A1").Select Selection.Delete Shift:=xlUp Range("B13").Select End Sub
詳しい手順はとりあえず省きますが、
どうやってるかわかりますかねー。。。?
あ、データはA1セルから提示のようにデータがあるとします。
繰り返すは後で考えればいいので、とりあえず、
セル範囲を決め打ちで、新しいファイルに名前を付けて保存が1回出来るように、
まずは作ってみましょう^^
(まっつわん) 2016/12/03(土) 13:23
重複のない一意の値のリスト作成は xl2003 ですから、マナさんコメントの通り フィルターオプションを使うことになります。 (xl2007以降なら、そのものずばりの 重複の先所機能があるんですが)
ところで、オートフィルターにしろ、フィルターオプションにしろ、【1行目がタイトル行】という前提になります。 マナさんから処理手順の説明がありましたが、重複の削除で フィルターオプションを使うなら、その他の処理も フィルターオプションにしてはどうでしょうか。
まず、元シートの他に抽出用シートを準備します。以下の説明では元シートを SHeet1、抽出用シートを SHeet2 としています。
1.SHeet1 を表示します。 2.フィルターオプション実行。ででてきたダイアログで 1)リスト範囲(L) を Sheet1 の A列。 2)指定した範囲(O) を選び 3)抽出範囲(T) に たとえば Sheet1 の F1 4)重複するレコードは無視する(R) をチェックしてOKボタン
これで、F列に、重複のない一意のリストができます。
3.SHeet2 を表示し、セル全体をクリアしておきます。 4.フィルターオプション実行。ででてきたダイアログで 1)リスト範囲(L) を Sheet1 の A列。 2)指定した範囲(O) を選び 3)抽出範囲(T) に Sheet2のA1 4)検索条件範囲(C)に Sheet1 の F1:F2 5)OKボタン(重複するレコードは無視する は、ここでは選びません)
これで、SHeet2 に 最初の文字に該当するレコードが抽出されているはずです。
5.SHeet2 のシートタブを右クリックし、移動またはコピー(M)を選びます。 1)移動先ブック名(T) を (新しいブック) 2)コピーを作成する(C) にチェックしてOKボタン
これで、SHeet2 だけがコピーされた新規ブックができていますので この新規ブックを名前をつけて保存した上でこのブックを閉じます。
6.Sheet1 の F2 を選択して セルの削除。 3行目以降が繰り上がります。
7.上記の3.に戻り処理継続。 Sheet1 の F2 が空白になるまで繰り返します。
これをマクロ記録するとコードが生成されます。
★なお、上記手順は A列のみコピーする内容ですが、実際には複数列のリストであれば 4.−1)のリストをA列だけではなく A:● 列にします。
(β) 2016/12/03(土) 18:04
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.