[[20190509101305]]　『全社員名簿から部署別名簿を作りたい』（mami）　ページの最後に飛ぶ

『全社員名簿から部署別名簿を作りたい』（mami）

全社員名簿があるのですが、
それを部署別にしたいです。
現在は、
アウトライン、小計を使用しているみたいなのですが、
部署が終わるごとに小計が入っていて、
実際見づらいのです。
なので、その後消しているのですが、面倒だなと…

もっと簡単な方法があるような気がしないでもないのですが、
どうしたら良いでしょうか。。。

＜使用 Excel：Excel2010、使用 OS：Windows7 ＞

 そりゃ、やろうと思えばどうとでもできますが、まずご自身はどのように
 なればいいのですか？
 小計を使っているという事は、グループごとに改ページが入るから
 印刷する時にそうしているのか？と思うのですが。

 シートごとに分けたいとか小計機能を使わなくても
 部署ごとに印刷したいとかそういった具体的な希望をかいてもらえますか？
 それと、マクロですか？
（コナミ） 2019/05/09(木) 10:24

そうですよね、すみません。

部署ごとにシートを分けたいです。
マクロが可能であればそうしたいです。
よろしくお願いします。
（mami） 2019/05/09(木) 10:37

mamiさん

現在お使いの表がどのようになっていて、それをどのようにしたいのでしょうか。
「全社員名簿があるのですが部署別にしたい」という漠然とした情報だけではなく、
同じシート内で作りたいor同じブック内の別シートで作りたいor別ブックで作りたい
名簿行と集計行がどのようになっているか（EXCELに、どういう基準で名簿行と集計行を判定させるかの材料になります）
という具体的な情報をお示しください。
（sheet無限増殖） 2019/05/09(木) 11:20

http://www.excel.studio-kazu.jp/kw/20110209184943.html
これ便利ですよ。。。私も使わせていただいています。
個人情報はダミーに変えて。。。。例えば。。。。下記に
貼り付けてみます。＾＾では

    |[A]  |[B]   |[C]   |[D]  |[E] |[F]     |[G]     
 [1]|ＩＤ |氏名  |部署  |役職 |年齢|連絡    |住所    
 [2]|10001|名前 1|部署 2|役 2 |  60|連絡　F2|住所　G2
 [3]|10002|名前 2|部署 1|役 3 |  39|連絡　F3|住所　G3
 [4]|10003|名前 3|部署 2|役 12|  36|連絡　F4|住所　G4
 [5]|10004|名前 4|部署 3|役 16|  61|連絡　F5|住所　G5
 [6]|10005|名前 5|部署 2|役 11|  45|連絡　F6|住所　G6
 [7]|10006|名前 6|部署 2|役 14|  74|連絡　F7|住所　G7
 [8]|10007|名前 7|部署 3|役 13|  59|連絡　F8|住所　G8
（隠居じーさん） 2019/05/09(木) 11:31

sheet無限増殖さん

ありがとうございます。

今は、一つのシートに
全社員分の氏名・所属部署が一覧であるのですが、
これを、
同じブック内で、部署名でシートが作成され、その部署シートに
氏名・所属等が出たらよいなと・・・
（mami） 2019/05/09(木) 11:55

 mamiさん

 所属部署は何列に入力されていますか？
 また、データは何行目から始まりますか？
 例）（1行目が見出しであれば、）2行目から

 そういう全社員名簿のレイアウトがわかるような情報がないと、みなさん回答できないと思いますよ…
 エスパーじゃないので(^^;
（虎） 2019/05/09(木) 12:15

そうなんですね！
すみませんー！

社員番号A列
氏名B列
所属J列

データは、3行目～です。

（mami） 2019/05/09(木) 12:54

 ※名簿シートの1行目はデータがない。
 ※　　　　　　A～J列の2行目が見出しで、ブランクがない。
 ↑を想定して作っています。もう少し詳細なデータ（隠居じーさんさんが示されたような表形式のもの）
 があればいいかもなぁ…(^^;

 Option Explicit

Sub test()

    Dim dic As Object, keys As Variant, buf
    Set dic = CreateObject("Scripting.Dictionary")
    Dim i As Long
    Dim wsMeibo As Worksheet, ws As Worksheet

    Set wsMeibo = ThisWorkbook.Sheets("名簿")
    With wsMeibo
        .Cells(3, "A").RemoveSubtotal
        For i = 3 To .Cells(Rows.Count, "J").End(xlUp).Row
            buf = .Cells(i, "J").Value
            If Not dic.exists(buf) Then
                dic.Add buf, buf
            End If
        Next i
        If .AutoFilterMode Then .Rows(1).AutoFilter
        keys = dic.keys
        For i = 0 To dic.Count - 1
            .Rows(2).AutoFilter field:=10, Criteria1:=keys(i)
            Set ws = Sheets.Add(after:=Sheets(Sheets.Count))
            ws.Name = keys(i)
            .Cells(2, "A").CurrentRegion.Copy
            ws.Cells(1, "A").PasteSpecial xlPasteAll
            Application.CutCopyMode = False
            Set ws = Nothing
        Next i
        .Rows(2).AutoFilter
    End With
    MsgBox "END"

End Sub

（虎） 2019/05/09(木) 14:19

こんな感じです！

     |[A]   |[B]  |[C]      |[D]                             
 [1] |社員??|氏名 |役職     |所属                            
 [2] |00001 |AAAAA|部長     |営業部　第１営業
 [3] |00002 |BBBBB|-        |営業部　第3営業
 [4] |00003 |CCCCC|-        |経理部
 [5] |00004 |DDDDD|-        |営業部　第１営業
 [6] |00005 |EEEEE|-        |経理部

（mami） 2019/05/09(木) 16:39

無駄な部分を削っていたら
d列までになってしまいました・・・
（mami） 2019/05/09(木) 16:40

 >無駄な部分を削っていたら 
 >d列までになってしまいました・・・

 いやいや、大丈夫です(^^)
 ただ、D列の所属でシートを切り分けたいんでしょうが、これって、
 D2セルの　営業部　第１営業　と、D3セルの　営業部　第3営業　は同じ営業部だから同じシートに…
 という解釈でよかったでしょうか？

（虎） 2019/05/09(木) 16:56

 ↑で質問しておいてなんですが、『営業部は営業部シートにまとめる』を前提として、コード載せておきます。
 一応、　（mami） 2019/05/09(木) 16:39　のサンプルでテストした結果は問題なかったので…大丈夫だと
 思いますが…。　自分もVBA勉強中の身ですので、あまり過信なさらずに、しっかりとテストしていただけたらと
 思いますm(_ _)m

 Option Explicit

Sub testDic()

    Dim dic As Object, keys As Variant, buf
    Set dic = CreateObject("Scripting.Dictionary")
    Dim i As Long
    Dim wsMeibo As Worksheet, ws As Worksheet

    Set wsMeibo = ThisWorkbook.Sheets("名簿")
    With wsMeibo
        .Cells(3, "A").RemoveSubtotal
        For i = 3 To .Cells(Rows.Count, "D").End(xlUp).Row
            buf = Split(.Cells(i, "D").Value, "　")(0)
            If Not dic.exists(buf) Then dic.Add buf, buf
        Next i
        If .AutoFilterMode Then .Rows(1).AutoFilter
        keys = dic.keys
        For i = 0 To dic.Count - 1
            .Rows(1).AutoFilter field:=4, Criteria1:=keys(i) & "*"
            Set ws = Sheets.Add(after:=Sheets(Sheets.Count))
            ws.Name = keys(i)
            .Cells(1, "A").CurrentRegion.Copy
            ws.Cells(1, "A").PasteSpecial xlPasteAll
            Application.CutCopyMode = False
            Set ws = Nothing
        Next i
        .Rows(1).AutoFilter
    End With
    MsgBox "END"

End Sub

（虎） 2019/05/09(木) 17:09

虎さん

すごい！できました！
ちなみにですが、
営業部の第1、第2と分ける場合は
どうしたら。。。
どっちのパターンもありそうなんですよね・・・
助けてください・・・
（mami） 2019/05/10(金) 08:40

 こんな感じでしょうか？(^^)

 Option Explicit

Sub tetsAL()

    Dim AL As Object, buf
    Set AL = CreateObject("System.Collections.ArrayList")
    Dim i As Long
    Dim wsMeibo As Worksheet, ws As Worksheet

    Set wsMeibo = ThisWorkbook.Sheets("名簿")
    With wsMeibo
        .Cells(3, "A").RemoveSubtotal
        For i = 3 To .Cells(Rows.Count, "D").End(xlUp).Row
            buf = .Cells(i, "D").Value
            If Not AL.contains(buf) Then AL.Add buf
        Next i
        AL.Sort
        If .AutoFilterMode Then .Rows(1).AutoFilter
        For i = 0 To AL.Count - 1
            .Rows(1).AutoFilter field:=4, Criteria1:=AL(i)
            Set ws = Sheets.Add(after:=Sheets(Sheets.Count))
            ws.Name = AL(i)
            .Cells(1, "A").CurrentRegion.Copy
            ws.Cells(1, "A").PasteSpecial xlPasteAll
            Application.CutCopyMode = False
            Set ws = Nothing
        Next i
        .Rows(2).AutoFilter
    End With
    MsgBox "END"

End Sub

 ただ、コード作っておきながらこんなこと言うのもなんですが、自分も業務の関係で
 社員名簿を見ることがあるんですが、もしも閲覧や印刷程度の使用なら、オートフィルタで部や課、係名で
 絞り込んで閲覧や印刷を行うのが一番簡単なんじゃないかなと…。
 自分の会社だと部だけで分けても20シートもできてしまって、逆に見るのめんどくさいなあ…って感じでした(^^;

（虎） 2019/05/10(金) 10:23

コメント返信：

[ 一覧(最新更新順) ]

[[20190509101305]] 『全社員名簿から部署別名簿を作りたい』（mami） ページの最後に飛ぶ

[[20190509101305]]　『全社員名簿から部署別名簿を作りたい』（mami）　ページの最後に飛ぶ