| |
▼kon さん：
おはようございます。
>>即興なので、イマイチ気に入らないのですが・・・。
>>'===========================================================
>>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
>このプログラムの説明、解説をどなたか教えていただけないでしょうか？
これの説明をするとなると、時間が必要です。出掛けにちょっと投稿
では無理なので・・・。
（ドキュメントを記述するのは大変です）
夜（もしかしたら明日）までには、何とか投稿しますから、待ってください。
でも、投稿コードは出来がよくないので
Jakaさんや小僧さんのコードを学んだ方がよいと思いますよ！！
|
|
ichinose
- 07/11/9(金) 7:46 -
