サムネ詐欺のようなマネをしてすまぬすまぬ・・

※※※本マクロご使用上の際のご注意※※※
エクセル上でのマクロの使用は、お使いの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 WAKIGEnemoto_HENSYUUyou_UserInput()

Dim y, s, RowsDltSftUpSTART, r, l, i As Long

y = 2

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

RowsDltSftUpSTART = y + 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

i = 0

Do While Len(Cells(RowsDltSftUpSTART + (i * s), 1)) <> 0

Rows(RowsDltSftUpSTART + (i * s) & ":" & RowsDltSftUpSTART + (i * s) + (l - 1)).Select
Selection.Delete Shift:=xlUp

i = i + 1

Loop

End Sub
-----------------------------
改変用っぽいもの
-----------------------------
Public Sub WAKIGEnemoto_HENSYUUyou()

Dim RowsDltSftUpSTART, i As Long

RowsDltSftUpSTART = 7

i = 0

Do While Len(Cells(RowsDltSftUpSTART + (i * 5), 1)) <> 0

Rows(RowsDltSftUpSTART + (i * 5) & ":" & RowsDltSftUpSTART + (i * 5) + 99).Select
Selection.Delete Shift:=xlUp

i = i + 1

Loop

End Sub

-----------------------------
毛を太くするモーフ追加用
-----------------------------
Public Sub TITIGE_S5_HUTOKU_x16_MORPH_UserInput()

Dim y, x, r, s, ss, b, k, j, l As Long

Dim CX, CY, CZ As Double

y = 2
x = 3

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

k = 0
j = 1

CX = 0
CY = 0
CZ = 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

b = Application.InputBox(prompt:="毛モデルを何倍太くするか、自然数の半角数値のみで入力してください。※本マクロでは毛モデルの先端部分は太くはなりません", Type:=1, Default:=16) ', 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

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

'If k <> s * r * j Then

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

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

Next i

CX = 0

For i = 0 To s - 1 Step 1

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

Next i

CY = 0

For i = 0 To s - 1 Step 1

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

Next i

CZ = 0

'Else

'j = j + 1

'End If

k = k + s

Loop

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

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

For i = 0 To s - 1 Step 1

Cells(y + i + l, x + 0) = 0

Next i

For i = 0 To s - 1 Step 1

Cells(y + i + l, x + 1) = 0

Next i

For i = 0 To s - 1 Step 1

Cells(y + i + l, x + 2) = 0

Next i

l = l + s * (r + 1)

Loop

End Sub