Info/excel-hop のバックアップの現在との差分(No.1)

バックアップ一覧
差分を表示
ソースを表示
バックアップを表示
Info/excel-hop へ行く。
- 1 (2021-12-09 (木) 01:42:14)
追加された行はこの色です。
削除された行はこの色です。
#author("2021-12-09T01:42:14+09:00","","")
[[Smile：D]]
#author("2021-12-09T01:43:52+09:00","","")
*Excel - Hop [#a3222374]



```
 Private Sub CommandButton1_Click()
     Dim Pos As String
     Pos = Range("Q2").Text
     GetMaxHop (Pos)
     
 End Sub
 
 
 
 Function GetMaxHop(ByVal Pos As String) As Long
 
     'セルにホップ数を記載しながらカウントしてます。
     '=> 初めに対象領域の値を削除する。
     Range("A1:P19").value = ""
 
     'ホップ数カウント対象の色取得
     Dim TargetColor As Long
     TargetColor = Range(Pos).Interior.Color
 
 
     '次の検索位置格納のためのリスト
     Dim TmpPosList As New Collection
     Dim TmpPos(2) As Long
     TmpPos(0) = Range(Pos).row
     TmpPos(1) = Range(Pos).Column
     TmpPosList.Add (TmpPos)
 
 
     Dim HopCount As Long
     HopCount = 0
     Cells(TmpPos(0), TmpPos(1)).value = HopCount
     HopCount = GetHopCount(TargetColor, TmpPosList, HopCount + 1)
 
     Debug.Print (HopCount)
 
     GetMaxHop = HopCount
 End Function
 
 Sub JudgeHopCount(ByVal TartetColor As Long, ByRef TmpPosList As Collection, HopCount As Long, ByVal PosRow As Long, ByVal PosColumn As Long)
         Dim TmpColor As Long
         Dim TmpText As String
         TmpColor = Cells(PosRow, PosColumn).Interior.Color
         TmpValue = Cells(PosRow, PosColumn).value
         If TmpColor = TartetColor And TmpValue = "" Then
             Cells(PosRow, PosColumn).value = HopCount
             Dim TmpPos(1) As Long
             TmpPos(0) = PosRow
             TmpPos(1) = PosColumn
             TmpPosList.Add (TmpPos)
         End If
 End Sub
 
 Function GetHopCount(ByVal TargetColor As Long, ByRef TmpPosList As Collection, HopCount As Long) As Long
     Dim TmpNextPosList As New Collection
 
     ' HopCount => 次のホップ数が格納されている。
 
     ' 隣接同一色のホップ数書き込み
     For Each Pos In TmpPosList
         Call JudgeHopCount(TargetColor, TmpNextPosList, HopCount, Pos(0) - 1, Pos(1) - 1)   '左上
         Call JudgeHopCount(TargetColor, TmpNextPosList, HopCount, Pos(0) - 1, Pos(1))       '上
         Call JudgeHopCount(TargetColor, TmpNextPosList, HopCount, Pos(0) - 1, Pos(1) + 1)   '右上
         Call JudgeHopCount(TargetColor, TmpNextPosList, HopCount, Pos(0), Pos(1) - 1)       '左
         Call JudgeHopCount(TargetColor, TmpNextPosList, HopCount, Pos(0), Pos(1) + 1)       '右
         Call JudgeHopCount(TargetColor, TmpNextPosList, HopCount, Pos(0) + 1, Pos(1) - 1)   '左下
         Call JudgeHopCount(TargetColor, TmpNextPosList, HopCount, Pos(0) + 1, Pos(1))        '下
         Call JudgeHopCount(TargetColor, TmpNextPosList, HopCount, Pos(0) + 1, Pos(1) + 1)   '右下
     Next
 
 
     If TmpNextPosList.Count > 0 Then
         ' ホップ数書き込みが発生 => HopCount が現在のホップ数
         GetHopCount = GetHopCount(TargetColor, TmpNextPosList, HopCount + 1)
     Else
         ' ホップ数書き込みが発生していない => 次のホップ数が HopCount のため、現在のホップ数は HopCount - 1
         GetHopCount = HopCount - 1
     End If
 End Function


Private Sub CommandButton1_Click()
    Dim Pos As String
    Pos = Range("Q2").Text
    GetMaxHop (Pos)
    
End Sub



Function GetMaxHop(ByVal Pos As String) As Long

    'セルにホップ数を記載しながらカウントしてます。
    '=> 初めに対象領域の値を削除する。
    Range("A1:P19").value = ""

    'ホップ数カウント対象の色取得
    Dim TargetColor As Long
    TargetColor = Range(Pos).Interior.Color


    '次の検索位置格納のためのリスト
    Dim TmpPosList As New Collection
    Dim TmpPos(2) As Long
    TmpPos(0) = Range(Pos).row
    TmpPos(1) = Range(Pos).Column
    TmpPosList.Add (TmpPos)


    Dim HopCount As Long
    HopCount = 0
    Cells(TmpPos(0), TmpPos(1)).value = HopCount
    HopCount = GetHopCount(TargetColor, TmpPosList, HopCount + 1)

    Debug.Print (HopCount)
    
    GetMaxHop = HopCount
End Function

Sub JudgeHopCount(ByVal TartetColor As Long, ByRef TmpPosList As Collection, HopCount As Long, ByVal PosRow As Long, ByVal PosColumn As Long)
        Dim TmpColor As Long
        Dim TmpText As String
        TmpColor = Cells(PosRow, PosColumn).Interior.Color
        TmpValue = Cells(PosRow, PosColumn).value
        If TmpColor = TartetColor And TmpValue = "" Then
            Cells(PosRow, PosColumn).value = HopCount
            Dim TmpPos(1) As Long
            TmpPos(0) = PosRow
            TmpPos(1) = PosColumn
            TmpPosList.Add (TmpPos)
        End If
End Sub

Function GetHopCount(ByVal TargetColor As Long, ByRef TmpPosList As Collection, HopCount As Long) As Long
    Dim TmpNextPosList As New Collection

    ' HopCount => 次のホップ数が格納されている。

    ' 隣接同一色のホップ数書き込み
    For Each Pos In TmpPosList
        Call JudgeHopCount(TargetColor, TmpNextPosList, HopCount, Pos(0) - 1, Pos(1) - 1)   '左上
        Call JudgeHopCount(TargetColor, TmpNextPosList, HopCount, Pos(0) - 1, Pos(1))       '上
        Call JudgeHopCount(TargetColor, TmpNextPosList, HopCount, Pos(0) - 1, Pos(1) + 1)   '右上
        Call JudgeHopCount(TargetColor, TmpNextPosList, HopCount, Pos(0), Pos(1) - 1)       '左
        Call JudgeHopCount(TargetColor, TmpNextPosList, HopCount, Pos(0), Pos(1) + 1)       '右
        Call JudgeHopCount(TargetColor, TmpNextPosList, HopCount, Pos(0) + 1, Pos(1) - 1)   '左下
        Call JudgeHopCount(TargetColor, TmpNextPosList, HopCount, Pos(0) + 1, Pos(1))        '下
        Call JudgeHopCount(TargetColor, TmpNextPosList, HopCount, Pos(0) + 1, Pos(1) + 1)   '右下
    Next


    If TmpNextPosList.Count > 0 Then
        ' ホップ数書き込みが発生 => HopCount が現在のホップ数
        GetHopCount = GetHopCount(TargetColor, TmpNextPosList, HopCount + 1)
    Else
        ' ホップ数書き込みが発生していない => 次のホップ数が HopCount のため、現在のホップ数は HopCount - 1
        GetHopCount = HopCount - 1
    End If
End Function

```