| |
▼ichinose さん：
>
>あっ、そういうことですか？
>
>即興なので、イマイチ気に入らないのですが・・・。
>'===========================================================
>Sub main()
> Dim g0 As Long
> Dim stt As Long
> Dim rng As Range
> Set rng = Range("g20")
> stt = 1
> For g0 = 1 To 20
> rng.Value = g0
> Set rng = get_rng(rng, stt)
> Next
>End Sub
>'===========================================================
>Function get_rng(ByVal rng, stt As Long) As Range
> Dim mx
> ReDim cnt(1 To 4) As Long
> ReDim chk(1 To 4) As Range
> ReDim locate(1 To 4) As Long
> Dim c As Long
> Dim g0 As Long
> Dim g1 As Long
> Dim g2 As Long
> For g0 = stt To (stt + 3)
> Select Case g0 Mod 4
> Case 1
> Set chk(c + 1) = rng.Offset(-1, 0)
> locate(c + 1) = 1
> Case 2
> Set chk(c + 1) = rng.Offset(0, 1)
> locate(c + 1) = 2
> Case 3
> Set chk(c + 1) = rng.Offset(1, 0)
> locate(c + 1) = 3
> Case 0
> Set chk(c + 1) = rng.Offset(0, -1)
> locate(c + 1) = 4
> End Select
> If chk(c + 1).Value = "" Then
> For g1 = -1 To 1
> For g2 = -1 To 1
> If g1 <> 0 Or g2 <> 0 Then
> If chk(c + 1).Offset(g1, g2).Value <> "" Then
> cnt(c + 1) = cnt(c + 1) + 1
> End If
> End If
> Next
> Next
> End If
> c = c + 1
> Next
> With Application
> g0 = .Match(.Max(cnt()), cnt(), 0)
> End With
> Set get_rng = chk(g0)
> stt = locate(g0)
>End Function
このプログラムの説明、解説をどなたか教えていただけないでしょうか？
|
|
kon
- 07/11/9(金) 2:11 -
