条件をつけて 抽出

いつもお世話になっております。
添付ファイルのように

B列　Ｃ列　　Ｄ列　　　Ｅ列　　　　Ｆ列
No 名前 　性別 血液型 生年月日
とあります。

男性だけを取り出して、
一気に吐き出そうとおもいましたが、
なぜか
女のところだけ空白になります。
（空白にならず、詰めたいのですが）

sortかける手もありますが、

一度でいかないものなのでしょうか
わかる方おしえてくれませんでしょうか


Sub a()
Dim i As Long
Dim j As Long
Dim cnt As Long
Dim myD As Variant
Dim myD2 As Variant

With Range("B2")
myD = .CurrentRegion.Value
.CurrentRegion.ClearContents
End With

ReDim myD2(1 To UBound(myD, 1), 1 To UBound(myD, 2))

cnt = 1

For i = 1 To UBound(myD, 1)
For j = 1 To UBound(myD, 2)

If myD(i, 3) = "男" Then
myD2(i, j) = myD(i, j)
End If

Next j
Next i

With Range("B2")
.Resize(UBound(myD, 1), UBound(myD, 2)) = myD2
End With
End Sub

質問者からの補足コメント

• このように結果したいのを
  添付しました。

  
    補足日時：2021/12/14 14:39

No.1 回答者： Qchan1962 回答日時： 2021/12/14 14:54

こんにちは

よく見ていませんが　配列作成の
myD2(i, j)　に変数　i　を使っている為ですよ　多分

myD2(n, j)= myD(i, j)
n=n+1

ReDim myD2(1 To UBound(myD, 1), 1 To UBound(myD, 2))については
不問で

この回答へのお礼

ありがとうございます。

お礼日時：2021/12/14 18:59

No.2 回答者： tatsumaru77 回答日時： 2021/12/14 15:04

ちょっと強引ですが、以下のようにしてください。

Sub a()
Dim i As Long
Dim j As Long
Dim i2 As Long
Dim flag As Boolean
Dim cnt As Long
Dim myD As Variant
Dim myD2 As Variant

With Range("B2")
myD = .CurrentRegion.Value
.CurrentRegion.ClearContents
End With

ReDim myD2(1 To UBound(myD, 1), 1 To UBound(myD, 2))

cnt = 1
i2 = 0
For i = 1 To UBound(myD, 1)
flag = False
If myD(i, 3) = "男" Or i2 = 0 Then
flag = True
i2 = i2 + 1
End If
For j = 1 To UBound(myD, 2)

If flag = True Then
myD2(i2, j) = myD(i, j)
End If

Next j
Next i

With Range("B2")
.Resize(UBound(myD, 1), UBound(myD, 2)) = myD2
End With
End Sub

この回答へのお礼

あまり使用しませんが
If flag = True Then
試してみます。
ありがとうございます。

お礼日時：2021/12/14 19:00

No.3 回答者： めぐみん_ 回答日時： 2021/12/14 15:17

間違いの訂正については出てますが、今のコードをそのままで

空白行を削除する②
http://doctor.ataglance.jp/mini-macro6/

なんてのも以前質問時に回答頂いてませんでしたっけ？

この回答へのお礼

ありがとうございます。

お礼日時：2021/12/14 19:01

No.4 回答者： めぐみん_ 回答日時： 2021/12/14 15:21

ついでですがこのような方法も。

https://www.kurumico.com/excel-vba-intermediate- …
・セル範囲の2次元配列でFilter関数を使うコード

この回答へのお礼

いつもお世話になっております。
Filter関数　参考にいたします。
ありがとうございます。

お礼日時：2021/12/14 19:02

No.5 ベストアンサー 回答者： Qchan1962 回答日時： 2021/12/14 15:21

＃１です

よく見るとcnt = 1は使っていないですね。
使い忘れ？
あと、配列を出力するサイズは、出力する配列サイズで.Resizeするべきですね。多分この場合、

同時にRedimもあらかじめサイズを取得できるのなら
した方が良いと思います。
少しだけ書き直しおてみましたが、結果は分かりません。

Sub a()
Dim i As Long
Dim j As Long
Dim cnt As Long
Dim myD As Variant
Dim myD2 As Variant
With Range("B2")
myD = .CurrentRegion.Value
ReDim myD2(1 To WorksheetFunction.CountIf(Range("D3", Cells(Rows.Count, "D").End(xlUp)), "男"), 1 To UBound(myD, 2))
.CurrentRegion.ClearContents
End With
cnt = 1
For i = 1 To UBound(myD, 1)
If myD(i, 3) = "男" Then
For j = 1 To UBound(myD, 2)
myD2(cnt, j) = myD(i, j)
Next j
cnt = cnt + 1
End If
Next i
With Range("B2")
.Resize(UBound(myD2, 1), UBound(myD2, 2)) = myD2
End With
End Sub

この回答へのお礼

いつもお世話になっております。

ReDim myD2(1 To WorksheetFunction.CountIf(Range("D3", Cells(Rows.Count, "D").End(xlUp)), "男"), 1 To UBound(myD, 2))
.CurrentRegion.ClearContents
End With

こんな　書き方初めてみました。
いろいろありますね

For i = 1 To UBound(myD, 1)
If myD(i, 3) = "男" Then　　　　　　　　ここに書くんですね
For j = 1 To UBound(myD, 2)
myD2(cnt, j) = myD(i, j)
Next j
cnt = cnt + 1
End If
Next i
ありがとうございました。

お礼日時：2021/12/14 19:06

No.6 回答者： めぐみん_ 回答日時： 2021/12/14 15:38

あ”。

ReDimの"男"の数については事前にWorksheetFunction.Countif(~で調べられますしね。
そう言ったのも使いようかも？

この回答へのお礼

ありがとうございました。

お礼日時：2021/12/14 19:07

No.7 回答者： fujillin 回答日時： 2021/12/14 16:08

こんにちは

別の方法でも良ければ・・・

ご参考までに。
（B列で最終行の判断をしています）

Sub Q12715319()
Dim v As Variant
Dim i As Long

i = Cells(Rows.Count, 2).End(xlUp).Row - 2
If i < 1 Then Exit Sub

With Cells(3, 4).Resize(i)
v = .Value
For i = 1 To UBound(v)
If v(i, 1) <> "男" Then v(i, 1) = ""
Next i
.Value = v
If WorksheetFunction.CountBlank(.Offset(0)) Then _
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub

この回答へのお礼

ありがとうございました。
If WorksheetFunction.CountBlank(.Offset(0)) Then _
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Withの部分参考にいたします。

お礼日時：2021/12/14 19:09