EXCEL

▼目次シートを作成し、目次からシートの遷移できるようにする
=HYPERLINK("#'"&R10&"'!A1",ROW()-6)
HYPERLINKの第一パラメータで「#'シート名'!A1」を指定すればＯＫ
注意点はシート名に「'」で囲む

Const First As Long = 4
Const Last As Long = 315
Const TopLevel As String = "H"
Const Level2 As String = "I"
Const Level3 As String = "J"
Const Level4 As String = "K"

Sub 空行の場合は上の内容をコピー()
'空欄の場合は、上の行をコピーし、文字色を灰色に変更する

'上から下にループする(1列のみ)

   topOld = Range(TopLevel & First).Value
   level2Old = Range(Level2 & First).Value
   
   For i = First To Last Step 1
       With Range(TopLevel & i)
           'TOPレベルは問答無用で空だったら上の行をコピーする
           If (.Value = "") Then
               .Value = topOld
               .Font.ColorIndex = 24   '灰色
           Else
               topOld = .Value
               level2Old = ""
               level3Old = ""
               level4Old = ""
           End If
       End With
       
       With Range(Level2 & i)
           'レベル2はレベル1が変わったタイミングでOLDの値をクリアする
           If (.Value = "") Then
               .Value = level2Old
               .Font.ColorIndex = 24   '灰色
           Else
               level2Old = .Value
               level3Old = ""
               level4Old = ""
           End If
       End With
       
       With Range(Level3 & i)
           'レベル3はレベル2が変わったタイミングでOLDの値をクリアする
           If (.Value = "") Then
               .Value = level3Old
               .Font.ColorIndex = 24   '灰色
           Else
               level3Old = .Value
               level4Old = ""
           End If
       End With
       
       
       With Range(Level4 & i)
           'レベル4はレベル3が変わったタイミングでOLDの値をクリアする
           If (.Value = "") Then
               .Value = level4Old
               .Font.ColorIndex = 24   '灰色
           Else
               level4Old = .Value
           End If
       End With
   Next
   

End Sub

Sub 上の行と同じ場合は削除()
'上の行と同じ場合は、データを削除する

'下から上にループする(1列のみ)

   For i = Last To First Step -1
       With Range(TopLevel & i)
           If (.Value = "") Then
               '空だったら何もしない
           Else
               '上の行と同じだったら削除する
               If (.Value = Range(TopLevel & i - 1)) Then
                   .Value = ""
               End If
           End If
       End With
       
       With Range(Level2 & i)
           If (.Value = "") Then
               '空だったら何もしない
           Else
               '上の行と同じだったら削除する
               If (.Value = Range(Level2 & i - 1)) Then
                   .Value = ""
               End If
           End If
       End With
       
       With Range(Level3 & i)
           If (.Value = "") Then
               '空だったら何もしない
           Else
               '上の行と同じだったら削除する
               If (.Value = Range(Level3 & i - 1)) Then
                   .Value = ""
               End If
           End If
       End With
       
       With Range(Level4 & i)
           If (.Value = "") Then
               '空だったら何もしない
           Else
               '上の行と同じだったら削除する
               If (.Value = Range(Level4 & i - 1)) Then
                   .Value = ""
               End If
           End If
       End With
   Next

End Sub

Sub レベル設定()

   level1Cnt = 1
   Level2Cnt = 0
   level3Cnt = 0
   Level4Cnt = 0
       
   topOld = Range(TopLevel & First).Value
   level2Old = Range(Level2 & First).Value
   level3Old = ""
   level4Old = ""
   
   For i = First To Last Step 1

       If (Range(TopLevel & i) <> topOld) Then
           '変わったらカウントして数字を入力
           level1Cnt = level1Cnt + 1
           Level2Cnt = 0
           level3Cnt = 0
           Level4Cnt = 0
           topOld = Range(TopLevel & i)
           level2Old = ""
           level3Old = ""
           level4Old = ""
       End If
       
       Range("A" & i).Value = level1Cnt

       If (Range(Level2 & i) = "") Then
           '何もしない
       Else
           If (Range(Level2 & i) <> level2Old) Then
               Level2Cnt = Level2Cnt + 1
               level3Cnt = 0
               Level4Cnt = 0
               level2Old = Range(Level2 & i)
               level3Old = ""
               level4Old = ""
           End If
           Range("B" & i).Value = Level2Cnt
       End If
           
       If (Range(Level3 & i) = "") Then
           '何もしない
       Else
           If (Range(Level3 & i) <> level3Old) Then
               level3Cnt = level3Cnt + 1
               Level4Cnt = 0
               level3Old = Range(Level3 & i)
               level4Old = ""
           End If
           Range("C" & i).Value = level3Cnt
       End If
       
       If (Range(Level4 & i) = "") Then
           '何もしない
       Else
           If (Range(Level4 & i) <> level4Old) Then
               Level4Cnt = Level4Cnt + 1
               level4Old = Range(Level4 & i)
           End If
           Range("D" & i).Value = Level4Cnt
       End If
   Next

End Sub