普段VBAを全く使わない初心者で申し訳ありません。
年度初めに作成したいものがあります。

下のシートのようなものがあり、これをグループ「ア」だけで名前と住所が入ったシート、「イ」だけで名前と住所が入ったシートを新規作成していくプログラムを教えていただきたいです。
なお、グループ名は10グループ程になる予定です。

よろしくお願いいたします。

A 回答 (3件)

こんばんは!



すでに回答は出ていますので、参考程度で・・・
標準モジュールです。

Sub Sample1()
Dim i As Long, k As Long, myCol As Long
Dim sN As String, wS As Worksheet, myFlg As Boolean
Application.ScreenUpdating = False
With Worksheets(1)
myCol = .Cells(1, Columns.Count).End(xlToLeft).Column + 2
.Range("C:C").AdvancedFilter Action:=xlFilterCopy, copytorange:=.Cells(1, myCol), unique:=True
.Columns(myCol).Sort key1:=.Cells(1, myCol), order1:=xlAscending, Header:=xlYes
For i = 2 To .Cells(Rows.Count, myCol).End(xlUp).Row
For k = 2 To Worksheets.Count
If Worksheets(k).Name = .Cells(i, myCol) Then
myFlg = True
Exit For
End If
Next k
If myFlg = False Then
Worksheets.Add after:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = .Cells(i, myCol)
End If
sN = .Cells(i, myCol)
Set wS = Worksheets(sN)
myFlg = False
wS.Move after:=Worksheets(i - 1)
wS.Cells.Clear
With .Range("A1").CurrentRegion
.AutoFilter field:=3, Criteria1:=.Cells(i, myCol)
.SpecialCells(xlCellTypeVisible).Copy wS.Range("A1")
End With
Next i
.AutoFilterMode = False
.Columns(myCol).Clear
End With
Application.ScreenUpdating = True
End Sub

こんな感じではどうでしょうか?m(_ _)m
    • good
    • 0
この回答へのお礼

コードを書いて頂き、ありがとうございます。

お礼日時:2016/03/05 21:00

私だったら、グループの数のシートは作成しませんね。


一例ですが、別途 シートに
 A    B   C
名前  住所  グループ
         ア
と云ったシートを準備して

C2セルにグループ名を入力したら
A,B列が表示される仕組みを考えます。
関数でも出来ますが、フィルターオプションの機能が便利です。
http://www4.synapse.ne.jp/yone/excel2010/excel20 …
を参考にしてみてください。
コードは、マクロの記録で簡単に作成できます。
次に、シートモジュールの
Private Sub Worksheet_Change(ByVal Target As Range)
・・・・
End Sub
にコピーすれば、C2セルを変更すると瞬時に希望の一覧になります。
シートは2枚で十分です。
マクロのコードも数行で可能です。
    • good
    • 0
この回答へのお礼

ありがとうございます。フィルターオプションバージョンも作成してみます。

お礼日時:2016/03/05 21:00

こんな感じでどうでしょう。

元データのシート名は、Sheet1としています。

Sub sample()
Dim ws As Worksheet
Dim I As Long
'元シートをコピーし作業用シートを作成。グループでソート&重複を削除する。
Sheets("Sheet1").Copy After:=Sheets(1)
Set ws = ActiveSheet
With ws.Sort
.SortFields.Clear
.SortFields.Add Key:=Range("C:C"), SortOn:=xlSortOnValues, _
Order:=xlAscending, DataOption:=xlSortNormal
.SetRange Range("A:C")
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
ws.Range("A:C").RemoveDuplicates Columns:=3, Header:=xlYes
'グループ毎のシート生成。
For I = 2 To ws.UsedRange.Rows.Count
If ws.Cells(I, 3) = "" Then Exit For
Sheets("Sheet1").Copy After:=Sheets(Sheets.Count)
With ActiveSheet
.Range("A:C").AutoFilter Field:=3, Criteria1:="<>" & ws.Cells(I, 3), _
Operator:=xlAnd
.Rows("2:" & .UsedRange.Rows.Count).Delete Shift:=xlUp
.Range("A:C").AutoFilter

.Name = ws.Cells(I, 3)
End With
Next I
'作業用シートの削除。
Application.DisplayAlerts = False
ws.Delete
Application.DisplayAlerts = True
End Sub
    • good
    • 0
この回答へのお礼

迅速な回答ありがとうございます。さっそく作ってみます。

お礼日時:2016/03/05 20:56

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!

このQ&Aを見た人はこんなQ&Aも見ています

今、見られている記事はコレ!

  • エクセルの図形機能で歌川国芳の浮世絵を描く動画

    教えて!goo動画マスターのスズです。自慢じゃないが私は絵がとても下手だ(本当に自慢じゃない)。6歳の子どもを相手に、言葉を口にせずに描いた絵だけでやりとりする「絵しりとり」をやっていて、「自転車」を描い...

  • 【長谷川豊】私はトランプ大統領の誕生を支持する

    先日、アメリカ共和党の関係者の方とお食事をさせてもらいました。 その方はもともと、マルコ・ルビオ候補者を推していたのですが、テレビの討論会会場で実際の討論能力を目の当たりにし「これはトランプが来るぞ」...

  • エルフ田さん:第70話「絵と向き合うということ」

    エルフ(ファンタジーとかに出てくる長寿の種族)の「エルフ田」と、ただの人間である女子社員2人による日常ギャグ。エルフならではのズレたツッコミでバシバシ人間界の話題を斬っていきます。

  • たまランチ:第46話「エビチリ」

    外ランチを愛してやまない元気な女子社員・たまちゃん(26)。オシャレなお店より「安くておいしい」お店が大好き! そんな女子力低めなたまちゃんの、色気より食い気な日々をつづります。

  • 女子必見!2016年のトレンド水着最新ナビ

    夏目前、今年もデパートでは水着がお目見えするようになった。「教えて!goo」には、スタイルに自信の無いという女性から「どんな水着を買えばいいのか わかりません」という質問が。これに対し、「ワンピースは、生...

おしトピ編集部からのゆる~い質問を出題中

お題をもっとみる

このQ&Aを見た人が検索しているワード

コンピュータやスピーカーなどのオーディオ、スマートフォンをはじめとした携帯電話とそのサービスに関する質問が充実。急なトラブルの対策案もここで得られるかもしれません。

このQ&Aを見た人がよく見るQ&A

このカテゴリの人気Q&Aランキング

おすすめ情報

カテゴリ