|
??? |
|
エクセルのマクロ。データ掃き出し。
Option Explicit Dim a(16) As Integer Sub Macro1() '_------5--(14)--6--(15)--7--(16)--8------ '_|____/_`______/_`______/_`______/_`____| '_|___|___|____|___|____|___|____|___|___| '(4)_(5)_(6)__(7)_(8)__(9)(10)_(11)(12)_(13) '_|___|___|____|___|____|___|____|___|___| '_|___`__/_____`__/_____`__/_____`__/____| '_------1---(1)--2--(2)--P3---(3)--4------ Cells(1, 1).Value = 0 Call saiki(1) Range("A1").Select End Sub Sub saiki(ByVal n As Integer) Dim QX As Integer Dim x As Integer Dim j As Integer a(n) = 1 While a(n) <= 16 If onaji(n) = 0 Then If n = 1 Then QX = -(a(1) = 2 Or a(1) = 3 Or a(1) = 9 Or a(1) = 10) Else x = 3 For j = 1 To n - 1 x = s(x, a(j)) Next j QX = Sgn(s(x, a(n))) End If If QX Then If n < 16 Then Call saiki(n + 1) ElseIf s(x, a(16)) = 3 Then Cells(1, 1).Value = Cells(1, 1).Value + 1 For j = 1 To 16 Cells(Cells(1, 1).Value, j + 1).Value = a(j) Next j End If End If End If a(n) = a(n) + 1 Wend End Sub Private Function s(ByVal x As Integer, ByVal y As Integer) As Integer If x = 1 And y = 1 Then s = 2 ElseIf x = 1 And (y = 4 Or y = 5 Or y = 6) Then s = 5 ElseIf x = 2 And y = 1 Then s = 1 ElseIf x = 2 And y = 2 Then s = 3 ElseIf x = 2 And (y = 7 Or y = 8) Then s = 6 ElseIf x = 3 And y = 2 Then s = 2 ElseIf x = 3 And y = 3 Then s = 4 ElseIf x = 3 And (y = 9 Or y = 10) Then s = 7 ElseIf x = 4 And y = 3 Then s = 3 ElseIf x = 4 And (y = 11 Or y = 12 Or y = 13) Then s = 8 ElseIf x = 5 And (y = 4 Or y = 5 Or y = 6) Then s = 1 ElseIf x = 5 And y = 14 Then s = 6 ElseIf x = 6 And (y = 7 Or y = 8) Then s = 2 ElseIf x = 6 And y = 14 Then s = 5 ElseIf x = 6 And y = 15 Then s = 7 ElseIf x = 7 And (y = 9 Or y = 10) Then s = 3 ElseIf x = 7 And y = 15 Then s = 6 ElseIf x = 7 And y = 16 Then s = 8 ElseIf x = 8 And (y = 11 Or y = 12 Or y = 13) Then s = 4 ElseIf x = 8 And y = 16 Then s = 7 Else s = 0 End If End Function Private Function onaji(ByVal n As Integer) As Integer Dim j As Integer onaji = 0 j = 1 While onaji = 0 And j < n If a(j) = a(n) Then onaji = 1 Else j = j + 1 End If Wend End Function |
|
4月5日(木) 13:13:31
39190 |