Thank you so much for all your support! They're very encouraging!!
「腋毛を太くする頂点モーフ」に関しては、
"アルゴリズム共有　その２　～ 毛編 ～" を参照してください。
その動画の方法で出来ます。

今回のマクロはすぐ出来るだろうなぁと思っていたら、意外と曲者な感じでした。。ｗ
毛モデルが拡散的であれば、拡散的に伸び、収束的であればその形のまま伸びます。
今回のマクロで気付いたことは、体の部位によって、拡散的な毛モデルにするのか、
収束的な毛モデルにするのか、ちゃんと選んだほうがいいんだなぁと。
陰毛の方に使用するのが無難な可能性もあります。
腋は狭すぎるのかもしれません。

※※※本マクロご使用上の際のご注意※※※
エクセル上でのマクロの使用は、お使いのPC環境によっては、動作機能を著しく低下させる恐れがあります。
本マクロご使用の際の前中後は、お使いのPCが安定した状態にあることを強く推奨いたします。
※※※※※※※※※※※※※※※※※※※※

！！！規則的毛モデルのルール追加！！！
一本の毛の根元ほど、頂点インデックスNoは若く、
毛先に近づいていくほど頂点インデックスNoは老番になっていくこと。
！！！！！！！！！！！！！！！！！！！

準備物
・モデルビュー上選択頂点群の全情報を.CSV化
https://ecchi.iwara.tv/images/%E3%83%A2%E3%83%87%E3%83%AB%E3%83%93%E3%83...

・今回使用したマクロ
-----------------------------
Public Sub WAKIGE_S5_NAGAKU_x4_MORPH_UserInput()

Dim y, x, y2, x2, r, s, ss, b, t, d, k, j, l As Long

Dim CX, CY, CZ, CX1, CY1, CZ1, CXt, CYt, CZt As Double

Dim Mname As String

Dim sheet As Worksheet

y = 2
x = 3

y2 = 4
x2 = 1

r = 20
s = 5
ss = 5
b = 16

t = 0
d = 0

k = 0
j = 1

CX = 0
CY = 0
CZ = 0

CX1 = 0
CY1 = 0
CZ1 = 0

CXt = 0
CYt = 0
CZt = 0

s = Application.InputBox(prompt:="毛モデル１本の底面の頂点数(角数)を数値のみで入力してください。", Type:=1, Default:=5) ', xpos:=1000, ypos:=2000
If IsNumeric(s) = False Or s < 1 Then 'isnumeric(cells(yy,xx).value) = false
MsgBox "1 値以上を入力してください。マクロを中断します。"
Exit Sub
End If

ss = s

r = Application.InputBox(prompt:="毛モデル１本の曲がり箇所数を数値のみで入力してください。", Type:=1, Default:=20) ', xpos:=1000, ypos:=2000
If IsNumeric(r) = False Or r < 1 Then 'isnumeric(cells(yy,xx).value) = false
MsgBox "1 値以上を入力してください。マクロを中断します。"
Exit Sub
End If

l = s * r
l = 0

b = Application.InputBox(prompt:="毛モデルを何倍長くするか、数値のみで入力してください。", Type:=1, Default:=4) ', xpos:=1000, ypos:=2000
If IsNumeric(b) = False Or b < 1 Then 'isnumeric(cells(yy,xx).value) = false
MsgBox "1 値以上を入力してください。マクロを中断します。"
Exit Sub
End If

b = b - 1

Mname = Application.InputBox(prompt:="モーフ名を入力してください。", Type:=3, Default:="腋毛長く(x" & b + 1 & ")") ', xpos:=1000, ypos:=2000
If Mname = "" Then
MsgBox "不適切な内容の入力です。マクロを中断します。"
Exit Sub
End If

Set sheet = ActiveSheet ' 現在アクティブなシートを取得する

Worksheets.Add After:=Worksheets(1)
ActiveSheet.Name = Mname

Worksheets(Mname).Cells(1, 1) = ";Morph"
Worksheets(Mname).Cells(1, 2) = "モーフ名"
Worksheets(Mname).Cells(1, 3) = "モーフ名(英)"
Worksheets(Mname).Cells(1, 4) = "パネル(0:無効/1:眉(左下)/2:目(左上)/3:口(右上)/4:その他(右下))"
Worksheets(Mname).Cells(1, 5) = "モーフ種類(0:グループモーフ/1:頂点モーフ/2:ボーンモーフ/3:UV(Tex)モーフ/4:追加UV1モーフ/5:追加UV2モーフ/6:追加UV3モーフ/7:追加UV4モーフ/8:材質モーフ/9:フリップモーフ/10:インパルスモーフ)"

Worksheets(Mname).Cells(2, 1) = "Morph"
Worksheets(Mname).Cells(2, 2) = Mname
Worksheets(Mname).Cells(2, 3) = ""
Worksheets(Mname).Cells(2, 4) = "4"
Worksheets(Mname).Cells(2, 5) = "1"

Worksheets(Mname).Cells(3, 1) = ";VertexMorph"
Worksheets(Mname).Cells(3, 2) = "親モーフ名"
Worksheets(Mname).Cells(3, 3) = "頂点Index"
Worksheets(Mname).Cells(3, 4) = "位置オフセット_x"
Worksheets(Mname).Cells(3, 5) = "位置オフセット_y"
Worksheets(Mname).Cells(3, 6) = "位置オフセット_z"

sheet.Activate ' シートをアクティブにする

Do While Cells(y + t, 2) <> ""

Worksheets(Mname).Cells(y2 + t, x2 + 2) = Cells(y + t, 2)
Worksheets(Mname).Cells(y2 + t, x2) = "VertexMorph"
Worksheets(Mname).Cells(y2 + t, x2 + 1) = Mname

t = t + 1

Loop

Do While Cells(y + k, 2) <> ""

For i = 0 To s - 1 Step 1

CX = CX + Cells(y + i + k, x + 0)

Next i

CX = CX / s

For i = 0 To s - 1 Step 1

CY = CY + Cells(y + i + k, x + 1)

Next i

CY = CY / s

For i = 0 To s - 1 Step 1

CZ = CZ + Cells(y + i + k, x + 2)

Next i

CZ = CZ / s

'-------------------------------------------

For i = 0 To s - 1 Step 1

CX1 = CX1 + Cells(y + i + k + s, x + 0)

Next i

CX1 = CX1 / s

For i = 0 To s - 1 Step 1

CY1 = CY1 + Cells(y + i + k + s, x + 1)

Next i

CY1 = CY1 / s

For i = 0 To s - 1 Step 1

CZ1 = CZ1 + Cells(y + i + k + s, x + 2)

Next i

CZ1 = CZ1 / s

'------------------------------------------------------------------------------------------

For i = 0 To s - 1 Step 1

Worksheets(Mname).Cells(y2 + i + k + s, x2 + 3) = (CX1 - CX) * b + CXt

Next i

CXt = CXt + (CX1 - CX) * b
CX = 0
CX1 = 0

For i = 0 To s - 1 Step 1

Worksheets(Mname).Cells(y2 + i + k + s, x2 + 4) = (CY1 - CY) * b + CYt

Next i

CYt = CYt + (CY1 - CY) * b
CY = 0
CY1 = 0

For i = 0 To s - 1 Step 1

Worksheets(Mname).Cells(y2 + i + k + s, x2 + 5) = (CZ1 - CZ) * b + CZt

d = d + 1

Next i

CZt = CZt + (CZ1 - CZ) * b
CZ = 0
CZ1 = 0

If d = s * (r + 1) Then

CXt = 0
CYt = 0
CZt = 0

d = 0

End If

k = k + s

Loop

'----------------------------------------------------------------------------------------

Do While Worksheets(Mname).Cells(y2 + l, x2 + 2) <> ""

For i = 0 To s - 1 Step 1

Worksheets(Mname).Cells(y2 + i + l, x2 + 3) = 0

Next i

For i = 0 To s - 1 Step 1

Worksheets(Mname).Cells(y2 + i + l, x2 + 4) = 0

Next i

For i = 0 To s - 1 Step 1

Worksheets(Mname).Cells(y2 + i + l, x2 + 5) = 0

Next i

l = l + s * (r + 1)

Loop

For i = 0 To s - 1 Step 1

Worksheets(Mname).Rows(y2 + t).Delete

Next i

'警告メッセージを表示しない
Application.DisplayAlerts = False
'アクティブシートを削除
ActiveSheet.Delete

End Sub
----------------------------------------------------
※ttps://president.jp/articles/-/29960?page=2
どうして陰毛やわき毛は、頭の髪質にかかわらず、ストレートヘアではなく、縮れているのでしょうか。

3つほど説があるのですが、まず“クッション説”から紹介しましょう。
わきも陰部も日常動作で擦れる場所なので、摩擦から肌を守るために、縮れ毛にすることでクッション性を持たせている、という説です。特に陰部は性交時に激しくぶつかります。その時の衝撃を吸収し、大切な性器を守り保護するため、というわけです。

2つ目が、“バリア説”です。陰毛が生えているあたりには大事な穴がいくつかあるため、縮れた陰毛が細菌やウイルスといった外敵の侵入を防ぐのに役立っている、という説です。

最後が“フェロモン説”です。人のフェロモンについてはよくわかっていないことが多いのですが、わきや陰部に発達しているアポクリン腺という部分から出て、異性を引きつけていると考えられています。
わきや陰部の毛を縮れさせることで、フェロモンが簡単に流れ落ちず、毛の周辺に留まることで、長い時間、発散させることができるというのです。
特に女性の場合、尿にもフェロモンが含まれているといわれており、陰毛に付着することで、より強力に放散され、男性を引き付ける力を発揮していることになります。
ちなみに、フェロモンは私たちが鼻で感じる匂いではないので、男性たちはいわゆる尿の匂いにひきつけられているわけではありません。

いずれも共通しているのが、直毛より縮れ毛のほうが表面積が増えるため、各作用が増強される、ということ。陰毛が縮れているのにも、それなりに重要な理由があることは間違いなさそうなので、私たちも温かな気持ちで受け入れていきましょう。

・・・っ！！(； ・`д・´)