teratail
回答率
85.30%
teratail header banner
teratail header banner
質問するログイン新規登録
トップVBAに関する質問VBA nCrの列挙

編集履歴

回答編集履歴

11

整理

2020/08/04 05:30

投稿

tosi
tosi

スコア553

answer CHANGED
@@ -1,41 +1,45 @@
1
- 依頼と少し違う感じかも知れませんが、こんなのではどうでしょうか。
1
+ 依頼と少し違う感じかも知れませんが、こんなのではどうでしょうか。A列に結果書き込まれます。
2
- A列に結果書き込まれます。定数域の数値を変更して色々遣って見て下さい。
3
2
  ```VBA
4
3
  Option Explicit
5
4
  '変数域
6
5
  Private lRow As Long
7
6
  Private lCol As Long
8
- Private giRayer As Integer
7
+ Private giLayer As Integer
8
+ Private giWorkLayerMax As Integer
9
9
  '定数域
10
- Private Const giCountMax As Integer = 5
10
+ Private Const giCountMax As Integer = 10
11
- Private Const giRayerMax As Integer = 6
11
+ Private Const giLayerMax As Integer = 3
12
12
  ' ***********************************************
13
13
  ' 開始
14
14
  ' ***********************************************
15
- Sub Test_Sample_Miniature()
15
+ Private Sub Test_Sample_Miniature()
16
+ Dim iX As Integer
16
17
  Range("A:A").Clear
17
18
  lRow = 0
18
19
  lCol = 1
20
+ For iX = 1 To giLayerMax
19
- giRayer = 0
21
+ giLayer = 0
22
+ giWorkLayerMax = iX
23
+ lRow = lRow + 1
24
+ Cells(lRow, lCol) = "(r = " & iX & ")"
20
- Call 自己参照(0, "")
25
+ Call 自己参照(0, "")
26
+ Next
21
27
  End Sub
22
28
  ' ***********************************************
23
29
  ' 自己参照
24
30
  ' ***********************************************
25
- Function 自己参照(iRayer As Integer, strPara As String) As Boolean
31
+ Private Function 自己参照(iLayer As Integer, strPara As String) As Boolean
26
32
  Dim iX As Integer
27
- Dim intWorkRay As String
33
+ Dim intWorkLay As String
28
34
  Dim strWorkPar As String
29
- giRayer = giRayer + 1
35
+ giLayer = giLayer + 1
30
- intWorkRay = giRayer
36
+ intWorkLay = giLayer
31
37
  strWorkPar = strPara
32
38
  For iX = 0 To giCountMax
33
- If giRayer < giRayerMax And iX <> giCountMax Then
39
+ If giLayer < giWorkLayerMax And iX <> giCountMax Then
34
40
  If strWorkPar = "" Then strPara = iX + 1 Else strPara = strWorkPar & "+" & iX + 1
35
- lRow = lRow + 1
36
- Cells(lRow, lCol) = strPara
37
- Call 自己参照(iRayer, strPara)
41
+ Call 自己参照(iLayer, strPara)
38
- giRayer = giRayer - 1
42
+ giLayer = giLayer - 1
39
43
  Else
40
44
  If iX <> giCountMax Then
41
45
  lRow = lRow + 1
@@ -52,42 +56,42 @@
52
56
  '変数域
53
57
  Private lRow As Long
54
58
  Private lCol As Long
55
- Private giRayer As Integer
59
+ Private giLayer As Integer
56
- Private giWorkRayerMax As Integer
60
+ Private giWorkLayerMax As Integer
57
61
  '定数域
58
62
  Private Const giCountMax As Integer = 10
59
- Private Const giRayerMax As Integer = 3
63
+ Private Const giLayerMax As Integer = 3
60
64
  ' ***********************************************
61
65
  ' 開始
62
66
  ' ***********************************************
63
- Sub Test_Sample_Miniature()
67
+ Private Sub Test_Sample_Miniature()
64
68
  Dim iX As Integer
65
69
  Range("A:A").Clear
66
70
  lRow = 0
67
71
  lCol = 1
68
- For iX = 1 To giRayerMax
72
+ For iX = 1 To giLayerMax
69
- giRayer = 0
73
+ giLayer = 0
70
- giWorkRayerMax = iX
74
+ giWorkLayerMax = iX
71
75
  lRow = lRow + 1
72
- 　　 Cells(lRow, lCol) = "(r = " & iX & ")"
76
+ Cells(lRow, lCol) = "(r = " & iX & ")"
73
77
  Call 自己参照(0, "")
74
78
  Next
75
79
  End Sub
76
80
  ' ***********************************************
77
81
  ' 自己参照
78
82
  ' ***********************************************
79
- Function 自己参照(iRayer As Integer, strPara As String) As Boolean
83
+ Private Function 自己参照(iLayer As Integer, strPara As String) As Boolean
80
84
  Dim iX As Integer
81
- Dim intWorkRay As String
85
+ Dim intWorkLay As String
82
86
  Dim strWorkPar As String
83
- giRayer = giRayer + 1
87
+ giLayer = giLayer + 1
84
- intWorkRay = giRayer
88
+ intWorkLay = giLayer
85
89
  strWorkPar = strPara
86
90
  For iX = 0 To giCountMax
87
- If giRayer < giWorkRayerMax And iX <> giCountMax Then
91
+ If giLayer < giWorkLayerMax And iX <> giCountMax Then
88
92
  If strWorkPar = "" Then strPara = iX + 1 Else strPara = strWorkPar & "+" & iX + 1
89
- Call 自己参照(iRayer, strPara)
93
+ Call 自己参照(iLayer, strPara)
90
- giRayer = giRayer - 1
94
+ giLayer = giLayer - 1
91
95
  Else
92
96
  If iX <> giCountMax Then
93
97
  lRow = lRow + 1
@@ -98,75 +102,45 @@
98
102
  Next
99
103
  End Function
100
104
  ```
101
- (再度追記)
105
+ (再追記)
102
106
  ```VBA
103
107
  Option Explicit
104
108
  '変数域
105
109
  Private lRow As Long
106
110
  Private lCol As Long
107
- Private giRayer As Integer
111
+ Private gintLayer As Integer
108
- Private giWorkRayerMax As Integer
109
112
  '定数域
110
113
  Private Const giCountMax As Integer = 10
111
- Private Const giRayerMax As Integer = 3
114
+ Private Const giLayerMax As Integer = 3
112
115
  ' ***********************************************
113
116
  ' 開始
114
117
  ' ***********************************************
115
- Sub Test_Sample_Miniature()
118
+ Private Sub Test_Sample_Miniature()
116
119
  Dim iX As Integer
117
- Range("A:A").Clear
120
+ Range("A:A").Clear: lRow = 0: lCol = 1
118
- lRow = 0
119
- lCol = 1
120
- For iX = 1 To giRayerMax
121
+ For iX = 1 To giLayerMax
121
- giRayer = 0
122
+ gintLayer = iX
122
- giWorkRayerMax = iX
123
- lRow = lRow + 1
124
- Cells(lRow, lCol) = "( r = " & iX & " )"
123
+ lRow = lRow + 1: Cells(lRow, lCol) = "(r = " & iX & ")"
125
- Call 自己参照(0, "")
124
+ Call 自己参照(1, 1, "")
126
125
  Next
127
126
  End Sub
128
127
  ' ***********************************************
129
128
  ' 自己参照
130
129
  ' ***********************************************
131
- Function 自己参照(iRayer As Integer, strPara As String) As Boolean
130
+ Private Function 自己参照(iPLayer As Integer, iPNextCount As Integer, strParam As String) As Boolean
132
- Dim iX As Integer
131
+ Dim iX As Integer
132
+ Dim iY As Integer
133
- Dim intWorkRay As String
133
+ Dim MyStr As String
134
- Dim strWorkPar As String
135
- giRayer = giRayer + 1
136
- intWorkRay = giRayer
137
- strWorkPar = strPara
138
- For iX = 0 To giCountMax
134
+ For iX = iPNextCount To giCountMax
139
- If giRayer < giWorkRayerMax And iX <> giCountMax Then
140
- If strWorkPar = "" Then strPara = iX + 1 Else strPara = strWorkPar & "+" & iX + 1
141
- Call 自己参照(iRayer, strPara)
142
- giRayer = giRayer - 1
135
+ If iPLayer < gintLayer Then
136
+ If giCountMax > iX Then
137
+ Call 自己参照(iPLayer + 1, iX + 1, strParam & "+" & iX)
138
+ End If
143
139
  Else
144
- If iX <> giCountMax Then
145
- If strWorkPar = "" Then strPara = iX + 1 Else strPara = strWorkPar & "+" & iX + 1
140
+ MyStr = strParam & "+" & iX
146
- If 判定(strPara) = True Then
147
- lRow = lRow + 1
141
+ lRow = lRow + 1
148
- Cells(lRow, lCol) = strPara
142
+ Cells(lRow, lCol) = Mid(MyStr, 2)
149
- End If
150
- End If
151
143
  End If
152
144
  Next
153
145
  End Function
154
- ' ***********************************************
155
- ' 判定
156
- ' ***********************************************
157
- Function 判定(strVal As String) As Boolean
158
- Dim MyArray As Variant
159
- Dim iX As Integer
160
- Dim iY As Integer
161
- MyArray = Split(strVal, "+")
162
- 判定 = True
163
- For iX = 0 To UBound(MyArray)
164
- For iY = iX + 1 To UBound(MyArray)
165
- If CInt(MyArray(iX)) >= CInt(MyArray(iY)) Then
166
- 判定 = False
167
- Exit Function
168
- End If
169
- Next
170
- Next
171
- End Function
172
146
  ```

10

10

2020/08/04 05:30

投稿

tosi
tosi

スコア553

answer CHANGED
@@ -107,7 +107,7 @@
107
107
  Private giRayer As Integer
108
108
  Private giWorkRayerMax As Integer
109
109
  '定数域
110
- Private Const giCountMax As Integer = 4
110
+ Private Const giCountMax As Integer = 10
111
111
  Private Const giRayerMax As Integer = 3
112
112
  ' ***********************************************
113
113
  ' 開始

9

再度追記

2020/08/01 02:39

投稿

tosi
tosi

スコア553

answer CHANGED
@@ -97,4 +97,76 @@
97
97
  End If
98
98
  Next
99
99
  End Function
100
+ ```
101
+ (再度追記)
102
+ ```VBA
103
+ Option Explicit
104
+ '変数域
105
+ Private lRow As Long
106
+ Private lCol As Long
107
+ Private giRayer As Integer
108
+ Private giWorkRayerMax As Integer
109
+ '定数域
110
+ Private Const giCountMax As Integer = 4
111
+ Private Const giRayerMax As Integer = 3
112
+ ' ***********************************************
113
+ ' 開始
114
+ ' ***********************************************
115
+ Sub Test_Sample_Miniature()
116
+ Dim iX As Integer
117
+ Range("A:A").Clear
118
+ lRow = 0
119
+ lCol = 1
120
+ For iX = 1 To giRayerMax
121
+ giRayer = 0
122
+ giWorkRayerMax = iX
123
+ lRow = lRow + 1
124
+ Cells(lRow, lCol) = "( r = " & iX & " )"
125
+ Call 自己参照(0, "")
126
+ Next
127
+ End Sub
128
+ ' ***********************************************
129
+ ' 自己参照
130
+ ' ***********************************************
131
+ Function 自己参照(iRayer As Integer, strPara As String) As Boolean
132
+ Dim iX As Integer
133
+ Dim intWorkRay As String
134
+ Dim strWorkPar As String
135
+ giRayer = giRayer + 1
136
+ intWorkRay = giRayer
137
+ strWorkPar = strPara
138
+ For iX = 0 To giCountMax
139
+ If giRayer < giWorkRayerMax And iX <> giCountMax Then
140
+ If strWorkPar = "" Then strPara = iX + 1 Else strPara = strWorkPar & "+" & iX + 1
141
+ Call 自己参照(iRayer, strPara)
142
+ giRayer = giRayer - 1
143
+ Else
144
+ If iX <> giCountMax Then
145
+ If strWorkPar = "" Then strPara = iX + 1 Else strPara = strWorkPar & "+" & iX + 1
146
+ If 判定(strPara) = True Then
147
+ lRow = lRow + 1
148
+ Cells(lRow, lCol) = strPara
149
+ End If
150
+ End If
151
+ End If
152
+ Next
153
+ End Function
154
+ ' ***********************************************
155
+ ' 判定
156
+ ' ***********************************************
157
+ Function 判定(strVal As String) As Boolean
158
+ Dim MyArray As Variant
159
+ Dim iX As Integer
160
+ Dim iY As Integer
161
+ MyArray = Split(strVal, "+")
162
+ 判定 = True
163
+ For iX = 0 To UBound(MyArray)
164
+ For iY = iX + 1 To UBound(MyArray)
165
+ If CInt(MyArray(iX)) >= CInt(MyArray(iY)) Then
166
+ 判定 = False
167
+ Exit Function
168
+ End If
169
+ Next
170
+ Next
171
+ End Function
100
172
  ```

8

(追記)

2020/07/31 23:03

投稿

tosi
tosi

スコア553

answer CHANGED
@@ -47,7 +47,6 @@
47
47
  End Function
48
48
  ```
49
49
  (追記)
50
- 求めているのは此方でしょうか。
51
50
  ```VBA
52
51
  Option Explicit
53
52
  '変数域

7

Cells(lRow, lCol) = "(r = " & iX & ")"

2020/07/31 21:56

投稿

tosi
tosi

スコア553

answer CHANGED
@@ -69,6 +69,8 @@
69
69
  For iX = 1 To giRayerMax
70
70
  giRayer = 0
71
71
  giWorkRayerMax = iX
72
+ lRow = lRow + 1
73
+ 　　 Cells(lRow, lCol) = "(r = " & iX & ")"
72
74
  Call 自己参照(0, "")
73
75
  Next
74
76
  End Sub

6

求めているのは此方でしょうか。

2020/07/31 21:43

投稿

tosi
tosi

スコア553

answer CHANGED
@@ -46,5 +46,54 @@
46
46
  Next
47
47
  End Function
48
48
  ```
49
+ (追記)
50
+ 求めているのは此方でしょうか。
51
+ ```VBA
52
+ Option Explicit
53
+ '変数域
54
+ Private lRow As Long
55
+ Private lCol As Long
56
+ Private giRayer As Integer
57
+ Private giWorkRayerMax As Integer
58
+ '定数域
59
+ Private Const giCountMax As Integer = 10
60
+ Private Const giRayerMax As Integer = 3
61
+ ' ***********************************************
62
+ ' 開始
63
+ ' ***********************************************
64
+ Sub Test_Sample_Miniature()
65
+ Dim iX As Integer
66
+ Range("A:A").Clear
67
+ lRow = 0
68
+ lCol = 1
69
+ For iX = 1 To giRayerMax
70
+ giRayer = 0
71
+ giWorkRayerMax = iX
72
+ Call 自己参照(0, "")
73
+ Next
74
+ End Sub
75
+ ' ***********************************************
76
+ ' 自己参照
77
+ ' ***********************************************
78
+ Function 自己参照(iRayer As Integer, strPara As String) As Boolean
79
+ Dim iX As Integer
80
+ Dim intWorkRay As String
81
+ Dim strWorkPar As String
82
+ giRayer = giRayer + 1
83
+ intWorkRay = giRayer
84
+ strWorkPar = strPara
85
+ For iX = 0 To giCountMax
86
+ If giRayer < giWorkRayerMax And iX <> giCountMax Then
87
+ If strWorkPar = "" Then strPara = iX + 1 Else strPara = strWorkPar & "+" & iX + 1
88
+ Call 自己参照(iRayer, strPara)
89
+ giRayer = giRayer - 1
49
- p.s.
90
+ Else
91
+ If iX <> giCountMax Then
92
+ lRow = lRow + 1
93
+ strPara = strWorkPar & "+" & iX + 1
50
- 色々と応用出来ます。CellのlColをiRayerに変えると面白いかも････
94
+ Cells(lRow, lCol) = strPara
95
+ End If
96
+ End If
97
+ Next
98
+ End Function
99
+ ```

5

Private

2020/07/31 21:37

投稿

tosi
tosi

スコア553

answer CHANGED
@@ -3,12 +3,12 @@
3
3
  ```VBA
4
4
  Option Explicit
5
5
  '変数域
6
- Public lRow As Long
6
+ Private lRow As Long
7
- Public lCol As Long
7
+ Private lCol As Long
8
- Public giRayer As Integer
8
+ Private giRayer As Integer
9
9
  '定数域
10
- Public Const giCountMax As Integer = 5
10
+ Private Const giCountMax As Integer = 5
11
- Public Const giRayerMax As Integer = 6
11
+ Private Const giRayerMax As Integer = 6
12
12
  ' ***********************************************
13
13
  ' 開始
14
14
  ' ***********************************************
@@ -47,5 +47,4 @@
47
47
  End Function
48
48
  ```
49
49
  p.s.
50
- VBの自己参照見た時には感動しました。
51
50
  色々と応用出来ます。CellのlColをiRayerに変えると面白いかも････

4

変更

2020/07/30 21:10

投稿

tosi
tosi

スコア553

answer CHANGED
@@ -5,8 +5,6 @@
5
5
  '変数域
6
6
  Public lRow As Long
7
7
  Public lCol As Long
8
- Public iY As Integer
9
- Public giCount As Integer
10
8
  Public giRayer As Integer
11
9
  '定数域
12
10
  Public Const giCountMax As Integer = 5
@@ -19,7 +17,6 @@
19
17
  lRow = 0
20
18
  lCol = 1
21
19
  giRayer = 0
22
- giCount = 0
23
20
  Call 自己参照(0, "")
24
21
  End Sub
25
22
  ' ***********************************************
@@ -27,7 +24,6 @@
27
24
  ' ***********************************************
28
25
  Function 自己参照(iRayer As Integer, strPara As String) As Boolean
29
26
  Dim iX As Integer
30
- Dim intCount As Integer
31
27
  Dim intWorkRay As String
32
28
  Dim strWorkPar As String
33
29
  giRayer = giRayer + 1

3

修正しました。

2020/07/30 04:03

投稿

tosi
tosi

スコア553

answer CHANGED
@@ -1,5 +1,3 @@
1
- ≪すみません。結果ダメですね。修正しますので参考程度に見て下さい。≫
2
-
3
1
  依頼と少し違う感じかも知れませんが、こんなのではどうでしょうか。
4
2
  A列に結果書き込まれます。定数域の数値を変更して色々遣って見て下さい。
5
3
  ```VBA
@@ -7,13 +5,12 @@
7
5
  '変数域
8
6
  Public lRow As Long
9
7
  Public lCol As Long
10
- Public iX As Integer
11
8
  Public iY As Integer
12
- Public iCount As Integer
9
+ Public giCount As Integer
13
- Public iRayer As Integer
10
+ Public giRayer As Integer
14
11
  '定数域
15
- Public Const iCountMax As Integer = 3
12
+ Public Const giCountMax As Integer = 5
16
- Public Const iRayerMax As Integer = 5
13
+ Public Const giRayerMax As Integer = 6
17
14
  ' ***********************************************
18
15
  ' 開始
19
16
  ' ***********************************************
@@ -21,35 +18,36 @@
21
18
  Range("A:A").Clear
22
19
  lRow = 0
23
20
  lCol = 1
21
+ giRayer = 0
24
- iCount = 0
22
+ giCount = 0
25
- iRayer = 0
26
- For iY = 1 To iRayerMax
27
- Call 自己参照(0, iCount, "")
23
+ Call 自己参照(0, "")
28
- Next
29
24
  End Sub
30
-
31
25
  ' ***********************************************
32
26
  ' 自己参照
33
27
  ' ***********************************************
34
- Function 自己参照(iRayer As Integer, iCount As Integer, strPara As String) As Boolean
28
+ Function 自己参照(iRayer As Integer, strPara As String) As Boolean
29
+ Dim iX As Integer
30
+ Dim intCount As Integer
31
+ Dim intWorkRay As String
35
- Dim strWork As String
32
+ Dim strWorkPar As String
36
- iRayer = iRayer + 1
33
+ giRayer = giRayer + 1
34
+ intWorkRay = giRayer
37
- strWork = strPara
35
+ strWorkPar = strPara
36
+ For iX = 0 To giCountMax
38
- If iRayer < iRayerMax Then
37
+ If giRayer < giRayerMax And iX <> giCountMax Then
39
- lRow = lRow + 1
40
- iCount = iCount + 1
41
- If strPara = "" Then strPara = iCount Else strPara = strPara & "+" & iCount
38
+ If strWorkPar = "" Then strPara = iX + 1 Else strPara = strWorkPar & "+" & iX + 1
42
- Cells(lRow, lCol) = strPara
43
- Call 自己参照(iRayer, 0, strPara)
44
- End If
45
- If iRayer > 1 Then
46
- For iX = iCount To iCountMax - 1
47
39
  lRow = lRow + 1
40
+ Cells(lRow, lCol) = strPara
41
+ Call 自己参照(iRayer, strPara)
42
+ giRayer = giRayer - 1
43
+ Else
44
+ If iX <> giCountMax Then
48
- iCount = iCount + 1
45
+ lRow = lRow + 1
49
- Cells(lRow, lCol) = strWork & "+" & iCount
46
+ strPara = strWorkPar & "+" & iX + 1
47
+ Cells(lRow, lCol) = strPara
48
+ End If
49
+ End If
50
- Next
50
+ Next
51
- End If
52
- iRayer = iRayer - 1
53
51
  End Function
54
52
  ```
55
53
  p.s.

2

参考

2020/07/30 03:59

投稿

tosi
tosi

スコア553

answer CHANGED
@@ -1,4 +1,4 @@
1
- ≪-すみません。結果ダメですね。修正しますので暫くお待ち下さい。-≫
1
+ ≪すみません。結果ダメですね。修正しますので参考程度に見て下さい。≫
2
2
 
3
3
  依頼と少し違う感じかも知れませんが、こんなのではどうでしょうか。
4
4
  A列に結果書き込まれます。定数域の数値を変更して色々遣って見て下さい。

1

修正

2020/07/30 02:39

投稿

tosi
tosi

スコア553

answer CHANGED
@@ -1,3 +1,5 @@
1
+ ≪-すみません。結果ダメですね。修正しますので暫くお待ち下さい。-≫
2
+
1
3
  依頼と少し違う感じかも知れませんが、こんなのではどうでしょうか。
2
4
  A列に結果書き込まれます。定数域の数値を変更して色々遣って見て下さい。
3
5
  ```VBA