エクセルについて質問します。

Excel 2002です。
以下のようなSheet1のデータを読み込み、Sheet2に以下のように順番に男女を分けて書き出したいです。
どのようにすればよろしいですか?
Aは名簿番号、Bは名前、Cは男が1、女が2です。


<Sheet1>
    A   B   C
------------------------------------------
3  1101 山田太郎 1
4  1102 山田次子 2
5  1103 山田三郎 1
6  1104 山田四郎 1
7  1105 山田五子 2
------------------------------------------


<Sheet2>
    A   B   C
------------------------------------------
3  1101 山田太郎 1
4  1103 山田三郎 1
5  1104 山田四郎 1

10  1102 山田次子 2
11  1105 山田五子 2
------------------------------------------

回答の条件
  • URL必須
  • 1人2回まで
  • 登録:2009/06/29 13:34:25
  • 終了:2009/06/30 08:56:53

ベストアンサー

id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692009/06/29 14:26:01

ポイント55pt

マクロで書けばこんな感じです。

Sub Macro()
    Dim lastRow As Long
    Dim i As Long
    Dim j As Long
    Dim s1 As Worksheet
    Dim s2 As Worksheet
    
    Set s1 = Worksheets("Sheet1")
    Set s2 = Worksheets("Sheet2")
    
    lastRow = s1.Cells(Rows.Count, 1).End(xlUp).Row
    
    j = 1
    For i = 1 To lastRow
        If s1.Cells(i, 3).Value = "1" Then
            s2.Cells(j, 1).Value = s1.Cells(i, 1).Value
            s2.Cells(j, 2).Value = s1.Cells(i, 2).Value
            s2.Cells(j, 3).Value = s1.Cells(i, 3).Value
            j = j + 1
        End If
    Next i
    
    '男女を1行空けるようにしています。必要なければ削除
    j = j + 1
    
    For i = 1 To lastRow
        If s1.Cells(i, 3).Value = "2" Then
            s2.Cells(j, 1).Value = s1.Cells(i, 1).Value
            s2.Cells(j, 2).Value = s1.Cells(i, 2).Value
            s2.Cells(j, 3).Value = s1.Cells(i, 3).Value
            j = j + 1
        End If
    Next i
End Sub

http://q.hatena.ne.jp/

id:kazumichi

誠にありがとうございます。

分かりやすく記述して下さり、感謝です。

また躓きましたら、なにとぞよろしくお願いいたします。

2009/06/29 14:51:01

その他の回答(1件)

id:geul No.1

geul回答回数120ベストアンサー獲得回数62009/06/29 13:44:38

ポイント15pt

「データ」→「並べ替え」→「最優先されるキー」をCにして、昇順で並べ替えます。

2番目に優先されるキーはAですね。これで分かれると思いますが、

男女の間に空白はできません。

http://yahoo.co.jp

id:kazumichi

ありがとうございます。

可能であれば、関数やマクロでの、具体的なコードを是非お願いいたします。

2009/06/29 13:53:55
id:SALINGER No.2

SALINGER回答回数3454ベストアンサー獲得回数9692009/06/29 14:26:01ここでベストアンサー

ポイント55pt

マクロで書けばこんな感じです。

Sub Macro()
    Dim lastRow As Long
    Dim i As Long
    Dim j As Long
    Dim s1 As Worksheet
    Dim s2 As Worksheet
    
    Set s1 = Worksheets("Sheet1")
    Set s2 = Worksheets("Sheet2")
    
    lastRow = s1.Cells(Rows.Count, 1).End(xlUp).Row
    
    j = 1
    For i = 1 To lastRow
        If s1.Cells(i, 3).Value = "1" Then
            s2.Cells(j, 1).Value = s1.Cells(i, 1).Value
            s2.Cells(j, 2).Value = s1.Cells(i, 2).Value
            s2.Cells(j, 3).Value = s1.Cells(i, 3).Value
            j = j + 1
        End If
    Next i
    
    '男女を1行空けるようにしています。必要なければ削除
    j = j + 1
    
    For i = 1 To lastRow
        If s1.Cells(i, 3).Value = "2" Then
            s2.Cells(j, 1).Value = s1.Cells(i, 1).Value
            s2.Cells(j, 2).Value = s1.Cells(i, 2).Value
            s2.Cells(j, 3).Value = s1.Cells(i, 3).Value
            j = j + 1
        End If
    Next i
End Sub

http://q.hatena.ne.jp/

id:kazumichi

誠にありがとうございます。

分かりやすく記述して下さり、感謝です。

また躓きましたら、なにとぞよろしくお願いいたします。

2009/06/29 14:51:01

コメントはまだありません

この質問への反応(ブックマークコメント)

「あの人に答えてほしい」「この質問はあの人が答えられそう」というときに、回答リクエストを送ってみてましょう。

これ以上回答リクエストを送信することはできません。制限について

絞り込み :
はてなココの「ともだち」を表示します。
回答リクエストを送信したユーザーはいません