teratail
回答率
85.47%
質問するログイン新規登録
トップアルゴリズムに関する質問円内の座標を求めること

編集履歴

回答編集履歴

6

ループの条件を書き換え

2020/10/25 12:49

投稿

kitasue
kitasue

スコア314

test CHANGED
@@ -41,10 +41,6 @@
41
41
  以上を元にコードを書いてみました。
42
42
 
43
43
  ```VBA
44
-
45
- Option Explicit
46
-
47
-
48
44
 
49
45
  Function f_blnTest1() As Boolean
50
46
 
@@ -98,45 +94,41 @@
98
94
 
99
95
 
100
96
 
101
- Do
97
+ Do While lngA * dblL <= 100 / 2
102
98
 
103
- Do
99
+ Do While Sqr((lngA * dblL) ^ 2 + (lngB * Sqr(3) * dblL) ^ 2) <= 100 / 2
104
100
 
105
101
  dblX = lngA * dblL
106
102
 
107
103
  dblY = lngB * Sqr(3) * dblL
108
104
 
109
- If Sqr(dblX ^ 2 + dblY ^ 2) <= 100 / 2 Then
105
+ lngRow1 = lngRow1 + 1
110
106
 
111
- lngRow1 = lngRow1 + 1
107
+ Cells(lngRow1, "A").Value = dblX
112
108
 
113
- Cells(lngRow1, "A").Value = dblX
109
+ Cells(lngRow1, "B").Value = dblY
114
110
 
115
- Cells(lngRow1, "B").Value = dblY
111
+ Cells(lngRow1, "E").Value = -dblX
116
112
 
117
- Cells(lngRow1, "E").Value = -dblX
113
+ Cells(lngRow1, "F").Value = -dblY
118
114
 
119
- Cells(lngRow1, "F").Value = -dblY
115
+ If dblX <> 0 And dblY <> 0 Then
120
116
 
121
- If dblX <> 0 And dblY <> 0 Then
117
+ lngRow2 = lngRow2 + 1
122
118
 
123
- lngRow2 = lngRow2 + 1
119
+ Cells(lngRow2, "C").Value = -dblX
124
120
 
125
- Cells(lngRow2, "C").Value = -dblX
121
+ Cells(lngRow2, "D").Value = dblY
126
122
 
127
- Cells(lngRow2, "D").Value = dblY
123
+ Cells(lngRow2, "G").Value = dblX
128
124
 
129
- Cells(lngRow2, "G").Value = dblX
130
-
131
- Cells(lngRow2, "H").Value = -dblY
125
+ Cells(lngRow2, "H").Value = -dblY
132
-
133
- End If
134
126
 
135
127
  End If
136
128
 
137
129
  lngB = lngB + 2
138
130
 
139
- Loop Until Sqr((lngA * dblL) ^ 2 + (lngB * Sqr(3) * dblL) ^ 2) > 100 / 2
131
+ Loop
140
132
 
141
133
  lngA = lngA + 3
142
134
 
@@ -144,9 +136,7 @@
144
136
 
145
137
  lngB = lngB0
146
138
 
147
- Loop Until lngA * dblL > 100 / 2
139
+ Loop
148
-
149
-
150
140
 
151
141
  End Function
152
142
 

5

コードを一部修正

2020/10/25 12:49

投稿

kitasue
kitasue

スコア314

test CHANGED
@@ -106,29 +106,31 @@
106
106
 
107
107
  dblY = lngB * Sqr(3) * dblL
108
108
 
109
-
109
+ If Sqr(dblX ^ 2 + dblY ^ 2) <= 100 / 2 Then
110
110
 
111
- lngRow1 = lngRow1 + 1
111
+ lngRow1 = lngRow1 + 1
112
112
 
113
- Cells(lngRow1, "A").Value = dblX
113
+ Cells(lngRow1, "A").Value = dblX
114
114
 
115
- Cells(lngRow1, "B").Value = dblY
115
+ Cells(lngRow1, "B").Value = dblY
116
116
 
117
- Cells(lngRow1, "E").Value = -dblX
117
+ Cells(lngRow1, "E").Value = -dblX
118
118
 
119
- Cells(lngRow1, "F").Value = -dblY
119
+ Cells(lngRow1, "F").Value = -dblY
120
120
 
121
- If dblX <> 0 And dblY <> 0 Then
121
+ If dblX <> 0 And dblY <> 0 Then
122
122
 
123
- lngRow2 = lngRow2 + 1
123
+ lngRow2 = lngRow2 + 1
124
124
 
125
- Cells(lngRow2, "C").Value = -dblX
125
+ Cells(lngRow2, "C").Value = -dblX
126
126
 
127
- Cells(lngRow2, "D").Value = dblY
127
+ Cells(lngRow2, "D").Value = dblY
128
128
 
129
- Cells(lngRow2, "G").Value = dblX
129
+ Cells(lngRow2, "G").Value = dblX
130
130
 
131
- Cells(lngRow2, "H").Value = -dblY
131
+ Cells(lngRow2, "H").Value = -dblY
132
+
133
+ End If
132
134
 
133
135
  End If
134
136
 

4

第２案に誤りを発見したため、一旦削除

2020/10/25 12:26

投稿

kitasue
kitasue

スコア314

test CHANGED
@@ -153,119 +153,3 @@
153
153
  原点が第一象限と第三象限でかぶっているのは仕様ですｗ
154
154
 
155
155
  座標の数は、9997個になりました。
156
-
157
-
158
-
159
- 次のコードなら、原点がかぶりません。
160
-
161
- ```VBA
162
-
163
- Function f_blnTest2() As Boolean
164
-
165
- Dim dblL As Double '六角形の一辺の半分
166
-
167
- Dim lngA As Long 'x軸方向の係数
168
-
169
- Dim lngB As Long 'y軸方向の係数の一部
170
-
171
- Dim lngB0 As Long 'y軸方向の係数の一部の初期値
172
-
173
- Dim lngRow1 As Long '第一、三象限のセルの行位置
174
-
175
- Dim lngRow2 As Long '第二、四象限のセルの行位置
176
-
177
- Dim dblX As Double '第一象限のx座標
178
-
179
- Dim dblY As Double '第一象限のy座標
180
-
181
- Dim wsh1 As Worksheet
182
-
183
-
184
-
185
- Set wsh1 = Worksheets(1)
186
-
187
- wsh1.Cells(1, 1).CurrentRegion.ClearContents
188
-
189
- lngRow1 = 1
190
-
191
- lngRow2 = 1
192
-
193
- wsh1.Cells(lngRow1, "A").Value = "第一象限x" 'x軸を含む
194
-
195
- wsh1.Cells(lngRow1, "B").Value = "第一象限y" 'y軸を含む
196
-
197
- wsh1.Cells(lngRow2, "C").Value = "第二象限x"
198
-
199
- wsh1.Cells(lngRow2, "D").Value = "第二象限y"
200
-
201
- wsh1.Cells(lngRow1, "E").Value = "第三象限x" 'x軸を含む
202
-
203
- wsh1.Cells(lngRow1, "F").Value = "第三象限y" 'y軸を含む
204
-
205
- wsh1.Cells(lngRow2, "G").Value = "第四象限x"
206
-
207
- wsh1.Cells(lngRow2, "H").Value = "第四象限y"
208
-
209
-
210
-
211
- dblL = Sqr(2) * 3 ^ (1 / 4) * Sqr(Atn(1)) / 6
212
-
213
-
214
-
215
- lngB0 = 1
216
-
217
- lngB = lngB0
218
-
219
- Do
220
-
221
- Do
222
-
223
- dblX = lngA * dblL
224
-
225
- dblY = lngB * Sqr(3) * dblL
226
-
227
-
228
-
229
- lngRow1 = lngRow1 + 1
230
-
231
- Cells(lngRow1, "A").Value = dblX
232
-
233
- Cells(lngRow1, "B").Value = dblY
234
-
235
- Cells(lngRow1, "E").Value = -dblX
236
-
237
- Cells(lngRow1, "F").Value = -dblY
238
-
239
- If dblX <> 0 And dblY <> 0 Then
240
-
241
- lngRow2 = lngRow2 + 1
242
-
243
- Cells(lngRow2, "C").Value = -dblX
244
-
245
- Cells(lngRow2, "D").Value = dblY
246
-
247
- Cells(lngRow2, "G").Value = dblX
248
-
249
- Cells(lngRow2, "H").Value = -dblY
250
-
251
- End If
252
-
253
- lngB = lngB + 2
254
-
255
- Loop Until Sqr((lngA * dblL) ^ 2 + (lngB * Sqr(3) * dblL) ^ 2) > 100 / 2
256
-
257
- lngA = lngA + 3
258
-
259
- lngB0 = 1 - lngB0
260
-
261
- lngB = lngB0
262
-
263
- Loop Until lngA * dblL > 100 / 2
264
-
265
-
266
-
267
- End Function
268
-
269
- ```
270
-
271
- 座標の数は、10006です。

3

第２案を一部修正

2020/10/24 23:11

投稿

kitasue
kitasue

スコア314

test CHANGED
@@ -214,7 +214,7 @@
214
214
 
215
215
  lngB0 = 1
216
216
 
217
- lngB = 1
217
+ lngB = lngB0
218
218
 
219
219
  Do
220
220
 

2

第２案を追加

2020/10/24 23:00

投稿

kitasue
kitasue

スコア314

test CHANGED
@@ -153,3 +153,119 @@
153
153
  原点が第一象限と第三象限でかぶっているのは仕様ですｗ
154
154
 
155
155
  座標の数は、9997個になりました。
156
+
157
+
158
+
159
+ 次のコードなら、原点がかぶりません。
160
+
161
+ ```VBA
162
+
163
+ Function f_blnTest2() As Boolean
164
+
165
+ Dim dblL As Double '六角形の一辺の半分
166
+
167
+ Dim lngA As Long 'x軸方向の係数
168
+
169
+ Dim lngB As Long 'y軸方向の係数の一部
170
+
171
+ Dim lngB0 As Long 'y軸方向の係数の一部の初期値
172
+
173
+ Dim lngRow1 As Long '第一、三象限のセルの行位置
174
+
175
+ Dim lngRow2 As Long '第二、四象限のセルの行位置
176
+
177
+ Dim dblX As Double '第一象限のx座標
178
+
179
+ Dim dblY As Double '第一象限のy座標
180
+
181
+ Dim wsh1 As Worksheet
182
+
183
+
184
+
185
+ Set wsh1 = Worksheets(1)
186
+
187
+ wsh1.Cells(1, 1).CurrentRegion.ClearContents
188
+
189
+ lngRow1 = 1
190
+
191
+ lngRow2 = 1
192
+
193
+ wsh1.Cells(lngRow1, "A").Value = "第一象限x" 'x軸を含む
194
+
195
+ wsh1.Cells(lngRow1, "B").Value = "第一象限y" 'y軸を含む
196
+
197
+ wsh1.Cells(lngRow2, "C").Value = "第二象限x"
198
+
199
+ wsh1.Cells(lngRow2, "D").Value = "第二象限y"
200
+
201
+ wsh1.Cells(lngRow1, "E").Value = "第三象限x" 'x軸を含む
202
+
203
+ wsh1.Cells(lngRow1, "F").Value = "第三象限y" 'y軸を含む
204
+
205
+ wsh1.Cells(lngRow2, "G").Value = "第四象限x"
206
+
207
+ wsh1.Cells(lngRow2, "H").Value = "第四象限y"
208
+
209
+
210
+
211
+ dblL = Sqr(2) * 3 ^ (1 / 4) * Sqr(Atn(1)) / 6
212
+
213
+
214
+
215
+ lngB0 = 1
216
+
217
+ lngB = 1
218
+
219
+ Do
220
+
221
+ Do
222
+
223
+ dblX = lngA * dblL
224
+
225
+ dblY = lngB * Sqr(3) * dblL
226
+
227
+
228
+
229
+ lngRow1 = lngRow1 + 1
230
+
231
+ Cells(lngRow1, "A").Value = dblX
232
+
233
+ Cells(lngRow1, "B").Value = dblY
234
+
235
+ Cells(lngRow1, "E").Value = -dblX
236
+
237
+ Cells(lngRow1, "F").Value = -dblY
238
+
239
+ If dblX <> 0 And dblY <> 0 Then
240
+
241
+ lngRow2 = lngRow2 + 1
242
+
243
+ Cells(lngRow2, "C").Value = -dblX
244
+
245
+ Cells(lngRow2, "D").Value = dblY
246
+
247
+ Cells(lngRow2, "G").Value = dblX
248
+
249
+ Cells(lngRow2, "H").Value = -dblY
250
+
251
+ End If
252
+
253
+ lngB = lngB + 2
254
+
255
+ Loop Until Sqr((lngA * dblL) ^ 2 + (lngB * Sqr(3) * dblL) ^ 2) > 100 / 2
256
+
257
+ lngA = lngA + 3
258
+
259
+ lngB0 = 1 - lngB0
260
+
261
+ lngB = lngB0
262
+
263
+ Loop Until lngA * dblL > 100 / 2
264
+
265
+
266
+
267
+ End Function
268
+
269
+ ```
270
+
271
+ 座標の数は、10006です。

1

説明追記

2020/10/24 21:46

投稿

kitasue
kitasue

スコア314

test CHANGED
@@ -149,3 +149,7 @@
149
149
  End Function
150
150
 
151
151
  ```
152
+
153
+ 原点が第一象限と第三象限でかぶっているのは仕様ですｗ
154
+
155
+ 座標の数は、9997個になりました。