VBA データの割合の求め方について

Question

前提・実現したいこと

CSVをExcelに取り込み、男女の人数と割合を出したいと考えています。
人数を出すところまではできたのですが、割合を求めるところで手も足も出なくなりました・・・。
図では5人しかいませんが、10人だったり、1人だったりと増減があります。
人数と同じように、割合も「Formula =男性の人数/総人数」と数式を入力し、
表示は「60%」とするようにしたいのです。
お詳しい方がいらっしゃいましたら宜しくお願い致します。

発生している問題・エラーメッセージ

エラーメッセージ

該当のソースコード

Sub test()
Dim fname As Variant
Dim wb As Workbook
Dim sh As Worksheet
Dim r As Long
Dim rng As Range
fname = Application.GetOpenFilename("CSVファイル(.csv),.csv", MultiSelect:=False)
If VarType(fname) = vbBoolean Then Exit Sub
Application.ScreenUpdating = False
With Worksheets("Sheet1")
Set wb = Workbooks.Open(fname)
Set sh = wb.Worksheets(1)
For r = 1 To sh.Cells(Rows.Count, 1).End(xlUp).Row
.Cells(r + 1, 1).Resize(, 2).Value = sh.Cells(r, 6).Resize(, 2).Value
.Cells(r + 1, 3).Resize(, 1).Value = sh.Cells(r, 30).Resize(, 1).Value
Next r
wb.Close
With .Cells(r + 2, 2).Resize(4, 1)
.HorizontalAlignment = xlCenter
.Cells(1, 1).Value = "男"
.Cells(2, 1).Value = "%"
.Cells(3, 1).Value = "女"
.Cells(4, 1).Value = "%"
.Offset(, 1).Resize(, 1).Formula = "=COUNTIF(C$3:C$" & r & ",$B" & r + 2 & ")"
End With
End With
Application.ScreenUpdating = True
MsgBox "取込が完了しました"
End Sub

説明](e5ba176666202863d9ee7a174b097b45.png)
図は実際にCSVを取り込んだ後のものですが、C列はなぜこんなに配置がバラバラになってしまうのでしょうか・・・。

試したこと

ここに問題に対して試したことを記載してください。

補足情報（FW/ツールのバージョンなど）

Answer 1

VBAでは無く、数式のみでやるやり方もあります。
人数の増減があるということですので、A～C列にはデータ以外置かないように、
B9からC12の内容をD9からE12に移して下さい。

その上でE9からE12のセルに以下の数式を入力して下さい。

E9 =COUNTIF(C:C,D9)
E10 =COUNTIF(C:C,D9)/(COUNTA(C:C)-1)*100
E11 =COUNTIF(C:C,D10)
E12 =COUNTIF(C:C,D10)/(COUNTA(C:C)-1)*100

これで人数が増えた場合でも自動的に人数、割合が表示されます。

Comments

[sum724]

ご回答いただきありがとうございます。なるほど！と思い実行してみましたらできました！
大変勉強になります。ありがとうございました。

[kaina]

上記数式は変更せず、CSVの取込部分のみをVBAで行うと常に最新の状態で
数式部分に人数、割合を表示することが出来ます。

Answer 2

下記の2行を追加すればどうでしょうか。

    With .Cells(r + 2, 2).Resize(4, 1)
        .HorizontalAlignment = xlCenter
        .Cells(1, 1).Value = "男"
        .Cells(2, 1).Value = "%"
        .Cells(3, 1).Value = "女"
        .Cells(4, 1).Value = "%"
        .Offset(, 1).Resize(, 1).Formula = "=COUNTIF(C$3:C$" & r & ",$B" & r + 2 & ")"
        .Cells(2, 2).Formula = "=C" & r + 2 & "/COUNTA(C$3:C$" & r & ")*100" '追加
        .Cells(4, 2).Formula = "=C" & r + 4 & "/COUNTA(C$3:C$" & r & ")*100" '追加
    End With

Comments

[sum724]

ご回答いただきありがとうございます！教えていただいた２行を追加することで無事できました。
ちなみに小数点以下を丸めたくて、この２行の下に
.Cells(2, 2).Value = WorksheetFunction.Round(.Cells(2, 2), 1)
.Cells(4, 2).Value = WorksheetFunction.Round(.Cells(2, 2), 1)
を追加したのですが、追加したらFormulaの効果がなくなって（？）しまい、
数字が表示されるだけとなってしまいました・・・。
記述する場所が間違っているのでしょうか。

[hatena19]

Value に代入したらFormulaは上書きされます。セルの書式で丸めるようにします。
.Cells(2, 2).NumberFormatLocal = "0.0_ "
.Cells(4, 2).NumberFormatLocal = "0.0_ "

[sum724]

あぁ～なるほど…！(><；　なんともお恥ずかしい…。
迅速に丁寧に教えていただけるので大変助かります。ありがとうございました！！