| |
▼やまだ さん：
>1
>2
>3 9 2 3
>4 ⇒ 8 1 4
>5 7 6 5
>6
>7
>8
>9
>
>簡単に言えば、こんな感じです。
あっ、そういうことですか？
即興なので、イマイチ気に入らないのですが・・・。
'===========================================================
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
>ちなみに、エクセルファイルってここに載せれるんですか？
ここは、出来ないですね！！
でも、だから勉強になるんですよ！！
ここに自分が知りたいことや知っていることを記述するのは大変なことです。
その大変なことをここでやろうとするから、上達するんです。
と、私は思っています。
|
|
ichinose
- 07/10/29(月) 19:39 -
