項目を既定の順番に並べなおす

Sub 項目を既定の順番に並べなおす()

Dim i_1, i_2, i_3
Dim ii '項目名用宣言
Dim nx As Integer '指定回数用宣言
Dim koumoku '項目用宣言

Range("A1").Select

i_1 = "項目1"
i_2 = "項目2"
i_3 = "項目3"

'該当する項目がなければ入力する
Range("A1").Select
koumoku = i_1
Do Until ActiveCell.Value = koumoku
ActiveCell.Offset(0, 1).Select
If ActiveCell.Value = "" Then
ActiveCell.Value = koumoku
Else
End If
Loop

----- べんりあつめ。-----

Range("A1").Select
koumoku = i_2
Do Until ActiveCell.Value = koumoku
ActiveCell.Offset(0, 1).Select
If ActiveCell.Value = "" Then
ActiveCell.Value = koumoku
Else
End If
Loop

Range("A1").Select
koumoku = i_3
Do Until ActiveCell.Value = koumoku
ActiveCell.Offset(0, 1).Select
If ActiveCell.Value = "" Then
ActiveCell.Value = koumoku
Else
End If
Loop

Call tool1

[A1:BZ60000].Sort [a1], Order1:=1, Orientation:=2 'BZ列の60000行までを1行目基準で列の並び替え

Call tool2
-----------------------------------------------------------------------------------
End Sub
Sub tool1()
'項目名を並べやすいように番号をつける
Rows("1:1").Select
Selection.Replace What:="項目1", Replacement:="01_項目1", LookAt:=xlWhole
Selection.Replace What:="項目2", Replacement:="02_項目2", LookAt:=xlWhole
Selection.Replace What:="項目3", Replacement:="03_項目3", LookAt:=xlWhole
End Sub
-----------------------------------------------------------------------------------
Sub tool2()
'項目名の数字を消す
Rows("1:1").Select
Selection.Replace What:="01_", Replacement:="", LookAt:=xlPart
Selection.Replace What:="02_", Replacement:="", LookAt:=xlPart
Selection.Replace What:="03_", Replacement:="", LookAt:=xlPart
End Sub