[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『「1つのシートからキー項目ごとに分割したシートを」[fine] について』(snow)
投稿
[[20120208211529]] 『1つのシートからキー項目ごとに分割したシートを』(fine)
について...
■このマクロを使った仕事の業務効率を高めたい者です。
参考にわかる方教えてください。
Sheet1に以下のデータがあります。
社員番号 所属 氏名 年齢 入社年月日 ・・・・ 0001 経理課 山本 32 2000/1/1 ・・・・ 0002 総務課 鈴木 40 1990/4/1 ・・・・ 0003 庶務課 山田 23 2005/4/1 ・・・・ 0004 経理課 中村 22 2005/4/1 ・・・・ 0005 製造課 本田 30 1999/4/1 ・・・・ 0006 経理課 青木 19 2010/4/1 ・・・・ 0007 総務課 中山 40 1980/4/1 ・・・・ 0008 製造課 田中 33 2000/1/1 ・・・・ 0009 庶務課 河野 21 2008/4/1 ・・・・ このシートを『所属』をキーに別々のシートに分割し、シート名を所属にしたいのですが、 過去のログ[[20050721182519]]を参考に、所属名でのシート分割ができたのですが、新しく 生成された所属ごとのシートをみると『Sheet1』で作成したセルの幅と異なり、標準のセル幅に なってしまいます。 『Sheet1』を基本フォーマットとして、『所属』をキーに別々のファイルに分割する方法を教えて いただけませんか。
この書き込みについて、キー項目がB列ではなくC列になるパターンについても
言及されていますが、同じ所属場のメンバーでこのマクロを共有する場合、
変更方法がわからないひともいるため、インプットボックスなどを出して
キー項目の「列」と「行」を指定(入力)し、マクロを実行するように
できたりしますか?
イメージとして、マクロ実行時に
1)「行」「列」を指定するインプットボックスが出る。
2)上記を入力して「OK」ボタンを押すとマクロが実行され、シートに分割される。
※分割条件
1)指定した行の上の行部分は分割されたシートすべてにヘッダーとして残る。
2)『Sheet1』の書式を引き継ぐ。(印刷範囲等も)
上記のようなものは作れるのでしょうか。
わかる方、教えてください。
よろしくお願いします。
< 使用 Excel:Excel2013、使用 OS:Windows8 >
全く違った方法になりますが、項目はどの行にあろうとA列から、ということで。
Sub test() Dim keyCol As String, myRow As Long, x, e keyCol = Application.InputBox("項目列の入力", , "C", Type:=2) myRow = Application.InputBox("項目行の入力", , 1, Type:=1) Application.ScreenUpdating = False With Sheets("sheet1") With .Range(keyCol & myRow, .Range(keyCol & Rows.Count).End(xlUp)) x = .Offset(1).Address x = Filter(.Parent.Evaluate("transpose(if(countif(offset(" & x & ",,,row(1:" & _ .Rows.Count & "))," & x & ")=1," & x & "))"), False, 0) End With For Each e In x DeleteSheet e .Copy after:=Sheets(Sheets.Count) With Sheets(Sheets.Count) .Name = e With .Range(keyCol & myRow, .Range(keyCol & Rows.Count).End(xlUp)) .AutoFilter 1, "<>" & e .Offset(1).EntireRow.Delete .AutoFilter End With End With Next End With Application.ScreenUpdating = True End Sub
Private Sub DeleteSheet(ByVal wsName As String) On Error Resume Next Application.DisplayAlerts = False ThisWorkbook.Sheets(wsName).Delete Application.DisplayAlerts = True On Error GoTo 0 End Sub
(seiya) 2017/07/01(土) 22:03
修正:
試してみましたが、「オブジェクトは、このプロパティまたはメソッドをサポートしていません」
と、エラーになります。
なぜでしょう?
(snow) 2017/07/01(土) 23:35
こちらの設定での動作は確認しています。
Step debug をして、どこで止まるか確認してください。 (seiya) 2017/07/01(土) 23:43
おっと、一か所ピリオドが抜けていました Parentの前(変更しておきます)
> x = Filter(Parent.Evaluate("transpose(if(countif(offset(" & x & ",,,row(1:" & _ .Rows.Count & "))," & x & ")=1," & x & "))"), False, 0)
x = Filter(.Parent.Evaluate("transpose(if(countif(offset(" & x & ",,,row(1:" & _ .Rows.Count & "))," & x & ")=1," & x & "))"), False, 0) (seiya) 2017/07/01(土) 23:48
試してみましたが、思い通りの結果です。
これで、無駄な時間が省けそうです。
大変助かりました。
(snow) 2017/07/02(日) 07:23
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.