[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『子供の計算問題』（寧々のパパ）
子供が学校で流行っているクイズを作って欲しいと言いました。
問題はシャッフルで出来たのですが、答えが出せません。
例として、5つの数字 13・2・3・5・6 を＋−×÷を使い答えを1にします。
数字の順番は変わっても構いません。
何通りも答えが出ると思いますが全てを表示できますか。
力添えをお願いします。
＜ 使用 Excel：Excel2010、使用 OS：Windows8 ＞
（γ） 2017/06/10(土) 17:43
（γ） 2017/06/10(土) 20:26
（寧々のパパ） 2017/06/10(土) 22:24
（γ） 2017/06/10(土) 22:34
5つの数字と四則計算、当然()も登場しますよね？ その中から1になる全ての組み合わせを求めるんですか？
解は0個〜数個程度でしょうけど、ループの組み合わせ数は天文学的な数字になりますよ。 解法があるのかは私は知りませんが、総当たりでの計算はEXCELでは不可能です。
例えば3つの組み合わせでしたら()の位置とかで120通りの組み合わせになりますが、 これは()の位置が1か所にしか入らないからです。 数字が4つならA*(B+C+D)やA/(B*(C+D))など()の組み合わせも増えるので単純に120の2乗にはならないです。 ちょっと正確な組み合わせ数の求め方は分かりませんが単純な2乗の14400通りでは無く、 3乗まではいかないと思いますが100万通り近くなるんじゃないでしょうか？ 数字5つだと、その4つの時の組み合わせ数の更に3乗近くなるので、天文学的数字になります。
全ての解を表示するのは諦めて、娘さんが打ち込んだ答えだけの答え合わせを自動化とかの方が良いと思います。
（sy） 2017/06/11(日) 08:25
（寧々のパパ） 2017/06/11(日) 21:44
それとも、問題が作れたのならば、例えば A1セルに 1+1*2 とか計算式を入力後、マクロで MsgBox Range("A1") & " = " & Evaluate("=" & Range("A1")) とかすれば計算した答えが得られますが、こういう事をお望みでしたか？
（???） 2017/06/12(月) 10:25
Dim x As Long, y As Long, i As Long, kekka, c1 As Range, c2 As Range
Cells.Clear
x = 1
For i = 132356 To 653213
If InStr(i, 13) * InStr(i, 2) * InStr(Replace(i, 13, ""), 3) * InStr(i, 5) * InStr(i, 6) > 0 Then
For y = 1 To 5
Cells(x, y) = IIf(Mid(Replace(i, 13, "@"), y, 1) = "@", "13", Mid(Replace(i, 13, "@"), y, 1))
Next y
x = x + 1
End If
Next i
x = 1
For i = 0 To 4444
If InStr(i, 1) * InStr(i, 2) * InStr(i, 3) * InStr(i, 4) > 0 Then
For y = 1 To 4
Cells(x, y + 10) = Choose(Mid(i, y, 1), "＋", "−", "×", "÷")
Next y
x = x + 1
End If
Next i
For Each c1 In Range("A:A").SpecialCells(xlCellTypeConstants)
For Each c2 In Range("K:K").SpecialCells(xlCellTypeConstants)
kekka = 0
Select Case c2.Value
Case "＋": kekka = c1.Value + c1.Offset(, 1).Value
Case "−": kekka = c1.Value - c1.Offset(, 1).Value
Case "×": kekka = c1.Value * c1.Offset(, 1).Value
Case "÷": kekka = c1.Value / c1.Offset(, 1).Value
End Select
Select Case c2.Offset(, 1).Value
Case "＋": kekka = kekka + c1.Offset(, 2).Value
Case "−": kekka = kekka - c1.Offset(, 2).Value
Case "×": kekka = kekka * c1.Offset(, 2).Value
Case "÷": kekka = kekka / c1.Offset(, 2).Value
End Select
Select Case c2.Offset(, 2).Value
Case "＋": kekka = kekka + c1.Offset(, 3).Value
Case "−": kekka = kekka - c1.Offset(, 3).Value
Case "×": kekka = kekka * c1.Offset(, 3).Value
Case "÷": kekka = kekka / c1.Offset(, 3).Value
End Select
Select Case c2.Offset(, 3).Value
Case "＋": kekka = kekka + c1.Offset(, 4).Value
Case "−": kekka = kekka - c1.Offset(, 4).Value
Case "×": kekka = kekka * c1.Offset(, 4).Value
Case "÷": kekka = kekka / c1.Offset(, 4).Value
End Select
If kekka = 1 Then MsgBox c1.Value & c2.Value & c1.Offset(, 1).Value & c2.Offset(, 1).Value & c1.Offset(, 2).Value & c2.Offset(, 2).Value & c1.Offset(, 3).Value & c2.Offset(, 3).Value & c1.Offset(, 4).Value
Next c2
Next c1
End Sub
（mm） 2017/06/12(月) 14:47
これってＥｘｃｅｌなんですかね？
或いは同じような物をって頼まれたのですか？
学校で流行っているのなら担任にでも聞いて、どんなものなのかを
調べてはいませんか？
（じゅんじゅん） 2017/06/12(月) 15:15
Sub test()
Dim iDim(4) As String
Dim cDim(3) As String
Dim i1 As Long
Dim i2 As Long
Dim i3 As Long
Dim i4 As Long
Dim i5 As Long
Dim j1 As Long
Dim j2 As Long
Dim j3 As Long
Dim j4 As Long
Dim iR As Long
Dim dw As Double
Application.ScreenUpdating = False
Cells.ClearContents
For i1 = 0 To 4
iDim(0) = Array(13, 2, 3, 5, 6)(i1)
For i2 = 0 To 4
If i1 <> i2 Then
iDim(1) = Array(13, 2, 3, 5, 6)(i2)
For i3 = 0 To 4
If i1 <> i3 And i2 <> i3 Then
iDim(2) = Array(13, 2, 3, 5, 6)(i3)
For i4 = 0 To 4
If i1 <> i4 And i2 <> i4 And i3 <> i4 Then
iDim(3) = Array(13, 2, 3, 5, 6)(i4)
For i5 = 0 To 4
If i1 <> i5 And i2 <> i5 And i3 <> i5 And i4 <> i5 Then
iDim(4) = Array(13, 2, 3, 5, 6)(i5)
For j1 = 0 To 3
cDim(0) = Array("+", "-", "*", "/")(j1)
For j2 = 0 To 3
If j1 <> j2 Then
cDim(1) = Array("+", "-", "*", "/")(j2)
For j3 = 0 To 3
If j1 <> j3 And j2 <> j3 Then
cDim(2) = Array("+", "-", "*", "/")(j3)
For j4 = 0 To 3
If j1 <> j4 And j2 <> j4 And i3 <> j4 Then
cDim(3) = Array("+", "-", "*", "/")(j4)
dw = Evaluate("=" & iDim(0) & cDim(0) & _
iDim(1) & cDim(1) & _
iDim(2) & cDim(2) & _
iDim(3) & cDim(3) & _
iDim(4))
If dw = 1 Then
iR = iR + 1
Cells(iR, "A").Value = iDim(0) & cDim(0) & _
iDim(1) & cDim(1) & _
iDim(2) & cDim(2) & _
iDim(3) & cDim(3) & _
iDim(4)
Cells(iR, "B").Value = dw
DoEvents
End If
End If
Next j4
End If
Next j3
End If
Next j2
Next j1
End If
Next i5
End If
Next i4
End If
Next i3
End If
Next i2
Next i1
Application.ScreenUpdating = True
End Sub
（???） 2017/06/12(月) 15:47
（寧々のパパ） 2017/06/12(月) 22:19
とりあえず下記の点を明確にしてください。
まず、
数値を６つ選ぶ、とのことですが、選ぶときに重複は許されるのかどうか。
次に、
演算子（+ - * /）は重複は許されるのかどうか。
例の式には、どちらも重複はないが、
1+1+1+2+2=7
というような式も正解になるのか。
前から順に計算するという限定条件はあるのか。
例の式 (8×6-22)÷2+1 は前から順に計算するようになっているが
これはたまたまなのでしょうか。
(5+7)/(4-3)*1=12
というような()を使って後の式を先に計算するような式も正解になるのか。
上記の条件がすべて許されるなら、提示の数値からできる数式の組み合わせ数は天文学的なものになるし、正解の式も天文学的に数になるので、すべての正解を出すというのは現実的ではないですね。
とりあえず、提示の数値から5つ選んで、それから総当りですべての式を生成してその計算結果が、提示の数値にあれば、正解として出力する、という仕様にすればなんとかなるかも。
5つの数値で式を生成する場合の数は、概算してみると数十万ぐらいになりそうです。正解の式もかなりの数になりそうです。
（hatena） 2017/06/13(火) 02:28
Excelならユーザーフォームを使っている可能性もありますが、
学校でってならExcelよりはタブレットの専用アプリな気もしますが。
娘さんがパソコンでExcelを使ってと言われているのかな？
（じゅんじゅん） 2017/06/13(火) 05:23
問題はシャッフルで出来たのですが、答えが出せません。
とは、数式は生成できて、答え(計算結果)の出し方がわからないという意味でしょうか。
もし、そうなら、簡単です。
Application.Evaluate(数式)
で計算結果はできます。
数値リストから、6の数値を抜き出すことはできた。
この数値から、数式 と 計算結果 が合う正解式を出力したい、ということでしょうか。
「問題はシャッフルで出来た」というコードも提示していただけるとより状況が把握しやすいですね。
（hatena） 2017/06/13(火) 09:24
更に、括弧アリですか！ 括弧があると、たとえ1回のみ使用だとしても、以下のパターンが考えられますが、使用個数の制限はないのですか？
制限が無いと、貴方のPCの性能とExcelの能力では、生きているうちに答えが出ないようなプログラムになってしまうかも知れませんよ？
a+b+c+d+e=f
(a+b)+c+d+e=f
(a+b+c)+d+e=f
(a+b+c+d)+e=f
(a+b+c+d+e)=f
a+(b+c)+d+e=f
a+(b+c+d)+e=f
a+(b+c+d+e)=f
a+b+(c+d)+e=f
a+b+(c+d+e)=f
a+b+c+(d+e)=f
同様に、計算記号の使用回数も、1回ずつのみであれば、組合せ数は 56*55*54*53*52*4*3*2 = 110億通り です。これに対する制限はどうなっていますか？ 回数制限なしだと、1173億通り程になります。 括弧アリだと、これらの組合せに括弧パターン数を掛けた回数をループする事になります。 単純ループで良いので、1兆回のループで何分かかるか、実験してみてください。ロジックを加えると、その時間の何十倍かの時間がかかる事でしょう。
（???） 2017/06/13(火) 09:41
ランダムに数字をいじって答えを探すだけならば、Excelとしては書いた式から自動的に答えを計算してあげるだけのマクロで十分だったりしませんか？ その方法なら、ここまでのサンプルコードで判りますよね？
（???） 2017/06/13(火) 09:55
実際には、更に計算記号の組合せ数と括弧の組合せ数をかけ算した時間と、式を計算して答え合わせする時間が増えますが、このコードに前の総当たり判定ロジックを組み合わせると、括弧無しパターン限定の求めるコードができあがります。 しかし、どれだけ実行時間がかかるのかを、少し体感してみてください。（ESCキーやCTRL+BREAKで中断）
Const iMAX = 56 Dim iDim1(iMAX - 1) As Long
Sub test()
Dim iDim2(iMAX - 1) As Long
Dim iSu(5) As Long
Dim i As Long
Dim iRet As Long
Dim dw As Double
Dim ipt As Long
iDim1(0) = 1: iDim1(1) = 1: iDim1(2) = 1: iDim1(3) = 2: iDim1(4) = 2
iDim1(5) = 2: iDim1(6) = 3: iDim1(7) = 3: iDim1(8) = 3: iDim1(9) = 4
iDim1(10) = 4: iDim1(11) = 4: iDim1(12) = 5: iDim1(13) = 5: iDim1(14) = 5
iDim1(15) = 6: iDim1(16) = 6: iDim1(17) = 6: iDim1(18) = 7: iDim1(19) = 7
iDim1(20) = 7: iDim1(21) = 7: iDim1(22) = 8: iDim1(23) = 8: iDim1(24) = 8
iDim1(25) = 8: iDim1(26) = 9: iDim1(27) = 9: iDim1(28) = 9: iDim1(29) = 9
iDim1(30) = 10: iDim1(31) = 10: iDim1(32) = 10: iDim1(33) = 10: iDim1(34) = 11
iDim1(35) = 11: iDim1(36) = 12: iDim1(37) = 12: iDim1(38) = 13: iDim1(39) = 13
iDim1(40) = 14: iDim1(41) = 14: iDim1(42) = 15: iDim1(43) = 15: iDim1(44) = 16
iDim1(45) = 16: iDim1(46) = 17: iDim1(47) = 17: iDim1(48) = 18: iDim1(49) = 19
iDim1(50) = 20: iDim1(51) = 21: iDim1(52) = 22: iDim1(53) = 23: iDim1(54) = 24
iDim1(55) = 25
For i = 0 To 5
iDim2(i) = 1
Next i
While iRet = 0
Call sNext(iDim2, iSu, iRet)
ipt = ipt + 1
If ipt Mod 1000 = 0 Then
Application.StatusBar = ipt & " 件 " & Round(100 * ipt / iMAX / (iMAX - 1) / (iMAX - 2) / (iMAX - 3) / (iMAX - 4) / (iMAX - 5), 3) & " %"
DoEvents
End If
Wend
Application.StatusBar = ipt & " 件"
MsgBox "終了"
End Sub
Sub sNext(iDim2() As Long, iSu() As Long, iRet As Long)
Dim i As Long
Dim ip As Long
Dim iAll As Long
While iAll <> 6
For i = 0 To iMAX - 1
If iDim2(i) = 0 Then
iDim2(i) = 1
Exit For
Else
iDim2(i) = 0
iDim2(i + 1) = iDim2(i + 1) + 1
If iDim2(i + 1) = 1 Then
Exit For
End If
End If
Next i
If iMAX <= i Then
iRet = 1
Exit Sub
End If
iAll = 0
For i = 0 To iMAX - 1
iAll = iAll + iDim2(i)
Next i
Wend
For i = 0 To iMAX - 1
If iDim2(i) = 1 Then
iSu(ip) = iDim1(i)
ip = ip + 1
End If
Next i
End Sub
（???） 2017/06/13(火) 11:15
???さんの熱意にコメントせざるを得ない。 お疲れ様です！ （稲葉） 2017/06/13(火) 11:21
Sub shuffle()
Application.ScreenUpdating = False
Worksheets(1).Select
Dim a As Range
Dim r()
Dim n, m, n2, i, j, t
Set a = Application.Range("A1:A56")
n = a.Rows.Count
m = a.Columns.Count
ReDim r(n * m)
n2 = 0
For i = 1 To n
For j = 1 To m
n2 = n2 + 1
r(n2) = a(i, j)
Next j
Next i
For i = 1 To n2
j = Int(n2 * Rnd()) + 1
t = r(i)
r(i) = r(j)
r(j) = t
Next i
For i = 1 To n
For j = 1 To m
a(i, j) = r(n2)
n2 = n2 - 1
Next j
Next i
Range("A1:A5").Copy Range("F4")
Range("A6").Copy Range("F10")
Sheets(2).Select
End Sub
（寧々のパパ） 2017/06/13(火) 20:56
ならば子供が考えた組み合わせが正しいかどうかの判定だけでは
まずいのでしょうか？
探すとスマホアプリにもそんなのならありましたけどね。
（じゅんじゅん） 2017/06/14(水) 07:15
これ結構大人も楽しめるんじゃない？ 小学生のころ、遠出したときに車のナンバーを並べ替えて 四則演算して10になるようにする遊びしてたこと思い出しました。
例だと (13-6)/(5*2-3)=1 とか 13-(6-2+5+3)=1 が解になるってことですよね。
みなさんが言うように、正しいかどうかの判断してあげれば済むような？ （稲葉） 2017/06/14(水) 08:28
括弧まで対応したければ、括弧なしのロジックで1パターンとし、後は固定位置に括弧を加えたもの（単に文字列連結するだけです）を想定されるパターン数分コピペしていけば、より多くの答えが見つかることでしょう。これならば、現実的な時間で結果が得られますし、貴方も自力でやれる内容かと思いますよ。
（???） 2017/06/14(水) 09:32
そういうことが言いたいのではなく、、、 なんていうのかな 答えを出すだけ、いつも完璧だけが教育ではないと思いますよ 一緒に考えてあげることも必要かと。
確かに総当たりロジックを走らせれば、やがて答えは出ると思いますが 人間らしいやりかた、仮説と立証のような考え方を教えることもよいと思います 主義主張を押し付けるわけではございませんが、今回の例でいえば 人につくってもらったロジックで、どう考えたの？と聞かれたとき答えられますか？
一番大きい数字の13を1にするには、13で割るか12を引く必要があるから 残りの数字で13か12を作ればよい みたいな考え方まで教えられますか？
話が脱線してしまいましたが、子供であれ部下であれ、ロジックを理解させることを 重視している私なりの考えです。 （稲葉） 2017/06/14(水) 23:44
なので、パパさんが考えた、ランダムで1種類作成するというコードは、妥当と思います。 だから後はこれを元に、出てきた5つの数字と答えが一致する全ての組合せを得るように、機能追加する案を出しました。全ての一致する答えを得るコード例も書きました。括弧を考慮する場合の変更方法も書きました。 あとは、これらを組み合わせた完成形が出てくるのを期待したのですが…。
とりあえず、ランダムで1種類作成し、それに対する答えが一致するものを羅列する完成形を書いてしまいます。ただし、括弧は考慮していませんので、括弧分を追加するのはお任せします。 数字の混ぜ方はちょっと違いますが、元の配列案でも構いません。 括弧については、最大でも4組までかと思われますので、パターン数はそう多くないと思います。括弧対応した最終形を目指すのは、お任せしますね。
Sub test()
Dim wk1 As Worksheet
Dim wk2 As Worksheet
Dim iDim(4) As String
Dim cDim(3) As String
Dim iQ(5) As Long
Dim i1 As Long
Dim i2 As Long
Dim i3 As Long
Dim i4 As Long
Dim i5 As Long
Dim j1 As Long
Dim j2 As Long
Dim j3 As Long
Dim j4 As Long
Dim iR As Long
Dim iw As Long
Dim dw As Double
Application.ScreenUpdating = False
Set wk1 = Sheets(1)
Set wk2 = Sheets(2)
wk2.Cells.ClearContents
'設問
With wk1
iw = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("B1:B" & iw).Formula = "=RAND()"
DoEvents
.Sort.SortFields.Clear
.Sort.SortFields.Add Key:=.Range("B1:B" & iw), SortOn:=xlSortOnValues
With .Sort
.SetRange wk1.Range("A1:B" & iw)
.Header = xlGuess
.Apply
End With
.Columns("B").ClearContents
End With
wk1.Range("A1:A5").Copy wk1.Range("F4")
wk1.Range("A6").Copy wk1.Range("F10")
For i1 = 0 To 5
iQ(i1) = wk1.Cells(i1 + 1, "A").Value
Next i1
'回答
For i1 = 0 To 4
iDim(0) = iQ(i1)
For i2 = 0 To 4
If i1 <> i2 Then
iDim(1) = iQ(i2)
For i3 = 0 To 4
If i1 <> i3 And i2 <> i3 Then
iDim(2) = iQ(i3)
For i4 = 0 To 4
If i1 <> i4 And i2 <> i4 And i3 <> i4 Then
iDim(3) = iQ(i4)
For i5 = 0 To 4
If i1 <> i5 And i2 <> i5 And i3 <> i5 And i4 <> i5 Then
iDim(4) = iQ(i5)
For j1 = 0 To 3
cDim(0) = Array("+", "-", "*", "/")(j1)
For j2 = 0 To 3
cDim(1) = Array("+", "-", "*", "/")(j2)
For j3 = 0 To 3
cDim(2) = Array("+", "-", "*", "/")(j3)
For j4 = 0 To 3
cDim(3) = Array("+", "-", "*", "/")(j4)
dw = Evaluate("=" & iDim(0) & cDim(0) & _
iDim(1) & cDim(1) & _
iDim(2) & cDim(2) & _
iDim(3) & cDim(3) & _
iDim(4))
If dw = iQ(5) Then
iR = iR + 1
wk2.Cells(iR, "A").Value = iDim(0) & cDim(0) & _
iDim(1) & cDim(1) & _
iDim(2) & cDim(2) & _
iDim(3) & cDim(3) & _
iDim(4)
wk2.Cells(iR, "B").Value = dw
End If
Next j4
Next j3
Next j2
Next j1
End If
Next i5
End If
Next i4
End If
Next i3
End If
Next i2
Next i1
'重複除去
If 0 < iR Then
wk2.Range("$A$1:$B$" & iR).RemoveDuplicates Columns:=1, Header:=xlNo
MsgBox "答え " & wk2.Cells(wk2.Rows.Count, "A").End(xlUp).Row & " 個", vbInformation, "終了"
Else
MsgBox "答えが見つかりません。", vbCritical, "エラー"
End If
Application.ScreenUpdating = True
End Sub
ちなみに、試しに動かしてみてでてきた問題で、難しいと思ったものと、条件が整列していて美しいな、と思うものを挙げておきます。
例題1：
3,4,7,11,11の5つを使い、答えが2になる式を作る。計算記号は+-*/の4種。同じ計算記号を複数回使ってもOKとする。
答え1：
括弧未使用の場合、答えは2種類。 括弧アリだと、「(3+4)/7+11/11=2」と簡単。括弧なしは難しい。
「3-7/11-4/11 =2」（引く順を逆にすると2つ目の答えになるが、この答えしかない！）
例題2：
2,3,4,5,6の5つを使い、答えが1になる式を作る。計算記号は+-*/の4種を、1回ずつ使うこと。括弧は使わない。
答え2：
答えは16種あるが、「3+2*6/4-5 =1」のように、全て 2*6/4=3 を利用し、3+3-5=1 にしているので、実質1種類と言っても良いくらい。 問題が覚えやすいので、子供同士で広めても面白いかと。
（???） 2017/06/15(木) 09:24
または、ランダムで取り出した候補をF4セル以下にコピーしている手前まで、元のご自身のコードに変えてみてください。やり方は違いますが、結果は同じなので。（元々、ご自身でここまで作って欲しかったものです）
（???） 2017/06/15(木) 21:59
総当たりの大変さを知ってもらうために書いたコードにバグがあるので、これを修正し、ついでに汎用化し、結果表示もできるようにした完成形を上げておきます。 問題作成の最終版のように、元データは1つ目のシートのA列に列挙しておく形にしました。30個くらいから6個抜き出す程度なら、10分くらいで結果が得られます。（%表示も勘違いしていて、分子は6個の数字を使う組合せだったのに、分母は個数無関係の総当たり数だったので、もの凄く小さい数字になっていました。実際には何日か回せば答えが出そう）
Const MAXSU = 6 Dim iMax As Long Dim cDim() As String
Sub test()
Dim wk1 As Worksheet
Dim wk2 As Worksheet
Dim iDim() As Long
Dim cSu(MAXSU - 1) As String
Dim i As Long
Dim iRet As Long
Dim dw As Double
Dim ipt As Long
Application.ScreenUpdating = False
Set wk1 = Sheets(1)
iMax = wk1.Cells(wk1.Rows.Count, "A").End(xlUp).Row
Set wk2 = Sheets(2)
wk2.Cells.ClearContents
ReDim cDim(iMax - 1)
ReDim iDim(iMax)
For i = 0 To iMax - 1
cDim(i) = wk1.Cells(i + 1, "A").Value
Next i
'例えば111111になる1つ前（111110）を初期値にする
For i = 1 To MAXSU - 1
iDim(i) = 1
Next i
While iRet = 0
Call sNext(iDim, cSu, iRet)
If iRet = 0 Then
ipt = ipt + 1
If ipt <= wk2.Rows.Count Then
wk2.Cells(ipt, "A").Resize(1, MAXSU).Value = cSu()
End If
If ipt Mod 100 = 0 Then
Application.StatusBar = ipt & " 通り"
DoEvents
End If
End If
Wend
Application.StatusBar = ipt & " 通り"
Application.ScreenUpdating = True
MsgBox ipt & " 通り", vbInformation, "終了"
End Sub
Sub sNext(iDim() As Long, cSu() As String, iRet As Long)
Dim i As Long
Dim ip As Long
Dim iAll As Long
While iAll <> MAXSU
iDim(0) = iDim(0) + 1
For i = 0 To iMax - 1
If iDim(i) = 2 Then
iDim(i) = 0
iDim(i + 1) = iDim(i + 1) + 1
Else
Exit For
End If
Next i
If 0 < iDim(iMax) Then
iRet = 1
Exit Sub
End If
iAll = 0
For i = 0 To iMax - 1
iAll = iAll + iDim(i)
Next i
Wend
For i = 0 To iMax - 1
If iDim(i) = 1 Then
cSu(ip) = cDim(i)
ip = ip + 1
End If
Next i
End Sub
（???） 2017/06/16(金) 15:01
'設問
With wk1
iw = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("B1:B" & iw).Formula = "=RAND()"
DoEvents
.Sort.SortFields.Clear
ここの.Sort.SortFields.Clearここで止まります。
（寧々のパパ） 2017/06/16(金) 22:39
２０１３かそれ以降にバージョンアップするか、他の手段を用いるか。
（じゅんじゅん） 2017/06/17(土) 05:47
2007からっす。 使用環境が2007より前の2003とか2000なんじゃないですかね？ http://excelwork.info/excel/cellsortcollection/ （稲葉） 2017/06/17(土) 08:43
（寧々のパパ） 2017/06/17(土) 21:42
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.