Excelで、条件で抽出したデータを、自動で別シート作成およびデータ出力したい
外部サイトで恐縮ですが、
こちら → http://oshiete1.nifty.com/qa6295795.html の内容が似ているとは思いますが、
シートの自動作成まで含めるとどうなるのでしょうか
添付画像のように、
sheet1に(画像ではすでに入力済みですが)、たとえば 地区 列に「え」と入力すると
【え】というシートが自動作成の上、地区え の行が出力される
次に「え」と入力すると同シートの次の行に出力される
【い】というシートも同様です。
このようにするにはどうすればいいのでしょうか?
事情により急いでいます。何卒よろしくお願いいたします。
No.5ベストアンサー
- 回答日時:
続けてお邪魔します。
No.4の
(1)新しく作成されたシートの番号欄は再び1から表示するようにしたい。
(2)入力シート(今はsheet1)で消した値や行は作成されたシートでも消えるようにしたい。
ex.バックスペースで地区に入力した値を消す
→作成されたシートの対応する値も消える
(3)新しく作成されたシートの行列の幅は入力シートと同じにしたい。
の件について
(1)
今までのコードはSheet名を「地区」名にするようにしていましたので
「番号欄は再び1から・・・」というのがよくわからないのですが、
とりあえずは入力順にSheetが追加されるはずですので手作業でSheet見出しをドラッグして
順番を入れ替えてみてください。
(もちろんコードでSheetを並び替えることも可能ですが、そんなにたびたび並び替える必要はなさそうなので)
(2)と(3)
コードをやり替えてみました。
まず前回の「標準モジュール」のコードをすべて削除して↓のコードにしてください。
Sub Sheet分け() 'この行から
Dim k As Long, str As String, wS As Worksheet, myFlg As Boolean
Set wS = Worksheets(1)
str = wS.Cells(Selection.Row - 1, "E")
Application.ScreenUpdating = False
For k = 2 To Worksheets.Count
If Worksheets(k).Name = str Then
myFlg = True
Exit For
End If
Next k
If myFlg = False Then
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = str
End If
Worksheets(str).Cells.ClearContents
With wS.Range("A1")
.AutoFilter field:=5, Criteria1:=str
.CurrentRegion.SpecialCells(xlCellTypeVisible).Copy
Worksheets(str).Activate
ActiveSheet.Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteColumnWidths
Selection.PasteSpecial Paste:=xlPasteAll
End With
wS.AutoFilterMode = False
Application.CutCopyMode = False
Application.ScreenUpdating = True
wS.Activate
End Sub 'この行まで
次にSheet1のシートモジュールもすべて削除し、↓のコードにしてください。
Private Sub Worksheet_Change(ByVal Target As Range) 'この行から
Dim i As Long, j As Long, lastCol As Long, str As String
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
i = Target.Row
j = Target.Column
If j <= lastCol And Target.Count = 1 Then
If Target <> "" Then
Call Sheet分け
Else
str = Cells(Target.Row, "E")
Worksheets(str).Cells.ClearContents
Range("A1").AutoFilter field:=5, Criteria1:=str
Range("A1").CurrentRegion.SpecialCells(xlCellTypeVisible).Copy _
Worksheets(str).Range("A1")
AutoFilterMode = False
End If
End If
End Sub 'この行まで
※ E列データを消去してしまうとフィルタがかけられませんので、エラーになってしまいます。
※ 今回もE列「地区」?でフィルタを掛けてE列をSheet名としています。
今度はどうでしょうか?m(_ _)m
ありがとうございます。再現できました。
VBAはいろんなことができるのですね。
勉強してみます。
シートは手作業でつくる場合も知りたくなったので
新たに別に質問させてもらおうと思います。
ありがとうございました。
No.4
- 回答日時:
No.2です。
>地区はE列(5列目)です。
>しかし他人に使ってもらうと列などの増減も考えられますので・・・
というコトですが、E列の「地区」は列・行が増えても変更がない!という前提です。
前回の「標準モジュール」のコードをすべて削除して↓に変更してみてうください。
(Sheetモジュールの方はそのままです)
Sub Sheet分け() 'この行から
Dim k As Long, str As String, wS As Worksheet, myFlg As Boolean
Set wS = Worksheets(1)
str = wS.Cells(Selection.Row - 1, "E") '←ココをE列に変更
For k = 2 To Worksheets.Count
If Worksheets(k).Name = str Then
myFlg = True
Exit For
End If
Next k
If myFlg = False Then
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = str
End If
Worksheets(str).Cells.ClearContents
With wS.Range("A1")
.AutoFilter Field:=5, Criteria1:=str '←E列でフィルタ
.CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Worksheets(str).Range("A1")
End With
wS.AutoFilterMode = False
End Sub 'この行まで
これで列が増えても対応できると思います。
今回はE列でオートフィルタを掛けています。
※ 今回もA~最終列まで入力されて(空白セルがなくなった状態で)初めてマクロが実行されるようにしています。m(_ _)m
ありがとうございます!できました!
しかし使ってみてわかったのですが、
いくつか気になる点が
・新しく作成されたシートの番号欄は再び1から表示するようにしたい。
・入力シート(今はsheet1)で消した値や行は作成されたシートでも消えるようにしたい。
ex.バックスペースで地区に入力した値を消す
→作成されたシートの対応する値も消える
・新しく作成されたシートの行列の幅は入力シートと同じにしたい。
これらが出来る方法はあるでしょうか。
それぞれのシートを個別に編集したほうが早いのかもしれませんが。
ちなみに簡易化するためにVBAの値のEをCに、5を3に、編集して、3列で試しています。
No.2
- 回答日時:
こんばんは!
>自動で別シート作成およびデータ出力したい
自動で別Sheet作成となるとVBAになってしまいます。
アップされている画像が小さすぎて詳細が判らないのですが、
とりあえずやり方だけ・・・
入力用のSheetはSheet見出しの一番左側に配置してあるとします。
勝手に表のレイアウトは↓の画像のようにしています。
まず Alt+F11キー → メニュー → 挿入 → VBE画面のカーソルが点滅しているところに
↓のコードをコピー&ペーストしてExcel画面に戻ってください。
Sub Sheet分け() 'この行から
Dim k As Long, str As String, wS As Worksheet, myFlg As Boolean
Set wS = Worksheets(1)
str = wS.Cells(Selection.Row - 1, "B") '←B列の選択セル行より1行上のB列データ
For k = 2 To Worksheets.Count
If Worksheets(k).Name = str Then
myFlg = True
Exit For
End If
Next k
If myFlg = False Then
Worksheets.Add(after:=Worksheets(Worksheets.Count)).Name = str
End If
Worksheets(str).Cells.ClearContents
With wS.Range("A1")
.AutoFilter field:=2, Criteria1:=str '←B列でオートフィルタを掛けている
.CurrentRegion.SpecialCells(xlCellTypeVisible).Copy Worksheets(str).Range("A1")
End With
wS.AutoFilterMode = False
End Sub 'この行まで
次にSheet見出しの一番左側(操作したいSheet見出し)上で右クリック → コードの表示 → VBE画面のカーソルが点滅しているところに
↓のコードをコピー&ペースト → Excel画面に戻りSheet1?にデータを入力してみてください。
Private Sub Worksheet_Change(ByVal Target As Range) 'この行から
Dim i As Long, j As Long, lastCol As Long
lastCol = Cells(1, Columns.Count).End(xlToLeft).Column
i = Target.Row
j = Target.Column
If j <= lastCol And Target.Count = 1 Then
If WorksheetFunction.CountBlank(Range(Cells(i, "A"), Cells(i, lastCol))) = 0 Then
Call Sheet分け
End If
End If
End Sub 'この行まで
※ 入力用Sheetのすべての項目列が埋まらないとマクロが実行されないようにしています。
※ 画像ではB列に「地区」のデータを入力するという前提です。
今回重要なのは「地区」の列がどこか?というコトなのですが
画像ではそれが判断できませんので、勝手にB列としています。
VBAの場合、1行・1列でも違えば全く意味のないものになりますので、
詳細が判れば具体的なアドバイスができると思います。m(_ _)m
ありがとうございます
列は左から
番号、氏名、都道府県、市区町村、地区、番地
となっていますので地区はE列(5列目)です。
しかし他人に使ってもらうと列などの増減も考えられますので、
変化に対応できるものであればいうことありません。
差し当たり地区はE列で作成したいです
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
関連するカテゴリからQ&Aを探す
おすすめ情報
- ・漫画をレンタルでお得に読める!
- ・人生のプチ美学を教えてください!!
- ・10秒目をつむったら…
- ・あなたの習慣について教えてください!!
- ・牛、豚、鶏、どれか一つ食べられなくなるとしたら?
- ・【大喜利】【投稿~9/18】 おとぎ話『桃太郎』の知られざるエピソード
- ・街中で見かけて「グッときた人」の思い出
- ・「一気に最後まで読んだ」本、教えて下さい!
- ・幼稚園時代「何組」でしたか?
- ・激凹みから立ち直る方法
- ・1つだけ過去を変えられるとしたら?
- ・【あるあるbot連動企画】あるあるbotに投稿したけど採用されなかったあるある募集
- ・【あるあるbot連動企画】フォロワー20万人のアカウントであなたのあるあるを披露してみませんか?
- ・映画のエンドロール観る派?観ない派?
- ・海外旅行から帰ってきたら、まず何を食べる?
- ・誕生日にもらった意外なもの
- ・天使と悪魔選手権
- ・ちょっと先の未来クイズ第2問
- ・【大喜利】【投稿~9/7】 ロボットの住む世界で流行ってる罰ゲームとは?
- ・推しミネラルウォーターはありますか?
- ・都道府県穴埋めゲーム
- ・この人頭いいなと思ったエピソード
- ・準・究極の選択
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
ExcelのVlookup関数の制限について
-
excel・VBAで奇数・偶数の分岐...
-
【条件付き書式】countifsで複...
-
エクセル 月のデータを週ごとに...
-
VBA 抽出後、別シートにコピー
-
エクセルの列の限界は255列以上...
-
Excelで、ファイル名、シート名...
-
エクセル マクロ 標準モジュー...
-
EXCEL VBAのコンボボックスに取...
-
"りんご"と"みかん"というシー...
-
エクセルで、チェックボックス...
-
A列をK列に変更
-
Excelで条件別にシートを振り分...
-
【VBA EXCEL データ有無 行 判...
-
検索に引っ掛からない文字行を...
-
【マクロ】あいうえお順のシー...
-
エクセル関数について、特定の...
-
エクセルVBAで、検索・抽出の仕...
-
エクセルのマクロで複数条件に...
-
VBA 元データに上書きする 列番...
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
ExcelのVlookup関数の制限について
-
エクセルの保護で、列の表示や...
-
文字の色も参照 VLOOKUP
-
Excel の複数シートの列幅を同...
-
VBAで繰り返しコピーしながら下...
-
【条件付き書式】countifsで複...
-
エクセル マクロ 標準モジュー...
-
エクセルの列の限界は255列以上...
-
Excelでの並べ替えを全シートま...
-
エクセルで、チェックボックス...
-
エクセルマクロを教えてほしい...
-
SUMPRODUCTにて別シートのデー...
-
Excel VBA ピボットテーブルに...
-
エクセルのブック分割マクロを...
-
【VBA】複数のシートの指定した...
-
excel 複数のシートの同じ場所...
-
Excelに自動で行の増減をしたい...
-
スプレッドシートでindexとIMPO...
-
エクセルで横並びの複数データ...
-
エクセル複数シートのデータを...
おすすめ情報