Excelのマクロで質問します

質問

A列には氏名が入っています。
B列には性別が入っています。（例えば男なら○印，女なら空白）
そこで，B列に○があれば男の列（C列）に，空白なら女の列（D列）に
それぞれ上から（１行目から）氏名を入力していくようにしたいです。
（つまり，C1は男の1番，C2は男の2番・・・・・，D１は女の1番，D2は女の2番・・・という感じです。）
このようなマクロについて，どなたか教えてください。
ちなみに1000行ぐらいまでデータがあるとします。

回答No.2

mu2011 · ベストアンサー

一例です

Sub sample()
For i = 1 To Cells(Rows.Count, "A").End(xlUp).Row
If Cells(i, "B") = "" Then
w = w + 1
Cells(w, "D") = Cells(i, "a")
Else
m = m + 1
Cells(m, "C") = Cells(i, "a")
End If
Next
End Sub

お礼

とても分かりやすい説明をありがとうございます。
うまくできました。

回答No.3

keithin

方法１）
１行目はタイトル行で，２行目からデータが並んでいるとする
絞り込んでコピーする
sub macro1()
　range("A:B").autofilter field:=2, criteria1:="○"
　range("A:A").copy destination:=range("C1")
　range("A:B").autofilter field:=2, criteria1:=""
　range("A:A").copy destination:=range("D1")
　activesheet.autofiltermode = false
end sub

方法２）
１行目から実データが並んでいるとする
並べ替えてまとめてコピーする
sub macro2()
　dim r as long
　range("A:B").copy destination:=range("C1")
　range("C:D").sort key1:=range("D1"), order1:=xlascending header:=xlno
　r = range("D65536").end(xlup).row
　range("D:D").clearcontents
　range(cells(r + 1, "C"), range("C65536").end(xlup)).cut destination:=range("D1")
end sub

お礼

回答ありがとうございます。
いろんな方法があるのですね。
勉強になりました。

回答No.1

tom04

こんにちは！
1行目は項目行で、データは2行目からあるとします。
一例です。

Sub test()
Dim i As Long
Application.ScreenUpdating = False
Columns("C:D").ClearContents
Cells(1, 3) = "男性"
Cells(1, 4) = "女性"
For i = 2 To Cells(Rows.Count, 1).End(xlUp).Row
If Cells(i, 2) = "○" Then
Cells(Rows.Count, 3).End(xlUp).Offset(1) = Cells(i, 1)
Else
Cells(Rows.Count, 4).End(xlUp).Offset(1) = Cells(i, 1)
End If
Next i
Application.ScreenUpdating = True
End Sub

こんな感じではどうでしょうか？m(__)m

お礼

とても分かりやすい説明をありがとうございました。
うまくできました。